Merging release 2.0 branch with CVS trunk
r2601 | ffr | 2008-05-30 10:26:57 +1000 (Fri, 30 May 2008) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
4a937e1608
commit
0749b0effa
129
drive.c
129
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)
|
||||
{
|
||||
if(argv[i+1] == NULL)
|
||||
{
|
||||
sprintf(pBueffel,"ERROR: no value found for driving %s",
|
||||
argv[i]);
|
||||
SCWrite(pCon,pBueffel,eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
}
|
||||
iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
|
||||
if (iRet == TCL_ERROR) {
|
||||
SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
|
||||
StopExe(GetExecutor(),"ALL");
|
||||
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;
|
||||
}
|
||||
for(i = 1; i < argc; i+=2) {
|
||||
if(argv[i+1] == NULL)
|
||||
{
|
||||
sprintf(pBueffel,"ERROR: no value found for driving %s",
|
||||
argv[i]);
|
||||
SCWrite(pCon,pBueffel,eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
}
|
||||
iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
|
||||
if (iRet == TCL_ERROR) {
|
||||
SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
} else if (!isfinite(dTarget)) {
|
||||
sprintf(pBueffel,"ERROR: target %s value for %s is not a finite number",
|
||||
argv[i+1], argv[i]);
|
||||
SCWrite(pCon,pBueffel,eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
for(i = 1; i < argc; i+=2) {
|
||||
iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
|
||||
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)
|
||||
{
|
||||
if(argv[i+1] == NULL)
|
||||
{
|
||||
sprintf(pBueffel,"ERROR: no value found for driving %s",
|
||||
argv[i]);
|
||||
SCWrite(pCon,pBueffel,eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
}
|
||||
iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
|
||||
if (iRet == TCL_ERROR) {
|
||||
SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
|
||||
StopExe(GetExecutor(),"ALL");
|
||||
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;
|
||||
}
|
||||
for(i = 1; i < argc; i+=2) {
|
||||
if(argv[i+1] == NULL)
|
||||
{
|
||||
sprintf(pBueffel,"ERROR: no value found for driving %s",
|
||||
argv[i]);
|
||||
SCWrite(pCon,pBueffel,eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
}
|
||||
iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
|
||||
if (iRet == TCL_ERROR) {
|
||||
SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
} else if (!isfinite(dTarget)) {
|
||||
sprintf(pBueffel,"ERROR: target value %s for %s is not a finite number",
|
||||
argv[i+1], argv[i]);
|
||||
SCWrite(pCon,pBueffel,eError);
|
||||
SetStatus(eOld);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
for(i = 1; i < argc; i+=2) {
|
||||
iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
|
||||
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;
|
||||
}
|
||||
|
||||
@ -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)
|
||||
|
||||
6
nxdict.c
6
nxdict.c
@ -191,9 +191,9 @@
|
||||
char *pPtr;
|
||||
int iToken;
|
||||
int iMode;
|
||||
char pAlias[132];
|
||||
char pDefinition[1024]; /* this is > 10 lines of definition */
|
||||
char pWord[132];
|
||||
char pAlias[1024];
|
||||
char pDefinition[8192]; /* this is > 10 lines of definition */
|
||||
char pWord[1024];
|
||||
|
||||
assert(pBuffer);
|
||||
assert(pDict);
|
||||
|
||||
@ -14,6 +14,8 @@
|
||||
#ifndef RS232CONTROLLER
|
||||
#define RS232CONTROLLER
|
||||
#include "network.h"
|
||||
#include "obdes.h" //PB
|
||||
#include "conman.h" //PB
|
||||
/*
|
||||
own error codes
|
||||
*/
|
||||
|
||||
@ -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)
|
||||
|
||||
14
site_ansto/ansto_evcontroller.h
Normal file
14
site_ansto/ansto_evcontroller.h
Normal file
@ -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
|
||||
@ -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;
|
||||
char buff[4];
|
||||
//int i;
|
||||
//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;
|
||||
char old_time_out[4];
|
||||
union {
|
||||
char chars[4];
|
||||
int val;
|
||||
} time_out;
|
||||
//int my_skt;
|
||||
//char old_time_out[4];
|
||||
//union {
|
||||
// char chars[4];
|
||||
// int val;
|
||||
//} time_out;
|
||||
char buff[128];
|
||||
struct RS__MsgStruct s_buff;
|
||||
struct RS__RespStruct r_buff;
|
||||
unsigned int oto_len, oto_status;
|
||||
struct hostent *rmt_hostent;
|
||||
struct in_addr *rmt_inet_addr_pntr;
|
||||
struct in_addr rmt_inet_addr;
|
||||
int rmt_sockname_len;
|
||||
struct sockaddr_in lcl_sockname;
|
||||
struct sockaddr_in rmt_sockname;
|
||||
//struct RS__MsgStruct s_buff;
|
||||
//struct RS__RespStruct r_buff;
|
||||
//unsigned int oto_len, oto_status;
|
||||
//struct hostent *rmt_hostent;
|
||||
//struct in_addr *rmt_inet_addr_pntr;
|
||||
//struct in_addr rmt_inet_addr;
|
||||
//int rmt_sockname_len;
|
||||
//struct sockaddr_in lcl_sockname;
|
||||
//struct sockaddr_in rmt_sockname;
|
||||
|
||||
char *errtxt_ptr;
|
||||
int errcode, my_errno, my_vaxc_errno;
|
||||
//char *errtxt_ptr;
|
||||
//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];
|
||||
union {
|
||||
char chars[4];
|
||||
int val;
|
||||
} time_out;
|
||||
//char old_time_out[4];
|
||||
//union {
|
||||
// char chars[4];
|
||||
// int val;
|
||||
//} 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;
|
||||
int errcode, my_errno, my_vaxc_errno;
|
||||
//char *errtxt_ptr;
|
||||
//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)
|
||||
*/
|
||||
|
||||
@ -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
|
||||
|
||||
135
site_ansto/hardsup/modbustcp.c
Normal file
135
site_ansto/hardsup/modbustcp.c
Normal file
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
/*-------------------------------------------------------------------------*/
|
||||
28
site_ansto/hardsup/modbustcp.h
Normal file
28
site_ansto/hardsup/modbustcp.h
Normal file
@ -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
|
||||
@ -105,14 +105,14 @@
|
||||
{
|
||||
int status;
|
||||
struct SerialInfo *my_info;
|
||||
void *my_hndl;
|
||||
struct hostent *rmt_hostent;
|
||||
struct in_addr *rmt_inet_addr_pntr;
|
||||
int rmt_sockname_len;
|
||||
struct sockaddr_in lcl_sockname;
|
||||
struct sockaddr_in rmt_sockname;
|
||||
char msr_cmnd[20];
|
||||
struct RS__RplyStruct *rply_ptr;
|
||||
//void *my_hndl;
|
||||
//struct hostent *rmt_hostent;
|
||||
//struct in_addr *rmt_inet_addr_pntr;
|
||||
//int rmt_sockname_len;
|
||||
//struct sockaddr_in lcl_sockname;
|
||||
//struct sockaddr_in rmt_sockname;
|
||||
//char msr_cmnd[20];
|
||||
//struct RS__RplyStruct *rply_ptr;
|
||||
|
||||
*pData = NULL;
|
||||
|
||||
@ -158,14 +158,14 @@
|
||||
{
|
||||
int status;
|
||||
struct SerialInfo *my_info;
|
||||
void *my_hndl;
|
||||
struct hostent *rmt_hostent;
|
||||
struct in_addr *rmt_inet_addr_pntr;
|
||||
int rmt_sockname_len;
|
||||
struct sockaddr_in lcl_sockname;
|
||||
struct sockaddr_in rmt_sockname;
|
||||
char msr_cmnd[20];
|
||||
struct RS__RplyStruct *rply_ptr;
|
||||
//void *my_hndl;
|
||||
//struct hostent *rmt_hostent;
|
||||
//struct in_addr *rmt_inet_addr_pntr;
|
||||
//int rmt_sockname_len;
|
||||
//struct sockaddr_in lcl_sockname;
|
||||
//struct sockaddr_in rmt_sockname;
|
||||
//char msr_cmnd[20];
|
||||
//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 bytes_to_come, bytes_left;
|
||||
//int status, c_len, size, max_size, ncmnds;
|
||||
int status, c_len, size, ncmnds;
|
||||
//int bytes_to_come, bytes_left;
|
||||
int bytes_left;
|
||||
int iResult;
|
||||
char *nxt_byte_ptr;
|
||||
char err_text[80];
|
||||
//char *nxt_byte_ptr;
|
||||
//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 text[20];
|
||||
char *txt_ptr;
|
||||
char *cmnd_lst_ptr;
|
||||
//char err_text[80];
|
||||
//char text[20];
|
||||
//char *txt_ptr;
|
||||
//char *cmnd_lst_ptr;
|
||||
struct RS__RplyStruct_V01B *ptr = NULL;
|
||||
long lMask = 0L;
|
||||
struct timeval tmo = {0,1};
|
||||
//long lMask = 0L;
|
||||
//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 text[20];
|
||||
char *txt_ptr;
|
||||
char *cmnd_lst_ptr;
|
||||
//char err_text[80];
|
||||
//char text[20];
|
||||
//char *txt_ptr;
|
||||
//char *cmnd_lst_ptr;
|
||||
struct RS__RplyStruct_V01B *ptr = NULL;
|
||||
long lMask = 0L;
|
||||
struct timeval tmo = {0,1};
|
||||
//long lMask = 0L;
|
||||
//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;
|
||||
|
||||
507
site_ansto/hardsup/west4100util.c
Normal file
507
site_ansto/hardsup/west4100util.c
Normal file
@ -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");
|
||||
}
|
||||
130
site_ansto/hardsup/west4100util.h
Normal file
130
site_ansto/hardsup/west4100util.h
Normal file
@ -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
|
||||
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
server_config.tcl
|
||||
barebones.tcl
|
||||
util
|
||||
gumxml.tcl
|
||||
config/hmm/anstohm_linked.xml
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
# $Revision: 1.7 $
|
||||
# $Date: 2008-05-12 01:08:15 $
|
||||
# $Revision: 1.8 $
|
||||
# $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
|
||||
|
||||
48
site_ansto/instrument/barebones.tcl
Normal file
48
site_ansto/instrument/barebones.tcl
Normal file
@ -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]"
|
||||
@ -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
|
||||
85
site_ansto/instrument/config/commands/commands_common.tcl
Normal file
85
site_ansto/instrument/config/commands/commands_common.tcl
Normal file
@ -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
|
||||
}
|
||||
################################################################################
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
@ -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
|
||||
|
||||
@ -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 {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
|
||||
add_hpath $basePath $arg_array(path)
|
||||
if {$basePath == "/"} {
|
||||
set node_path /$arg_array(path)
|
||||
} else {
|
||||
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 [ catch {
|
||||
array set arg_array $args
|
||||
if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
|
||||
add_hpath $basePath $arg_array(path)
|
||||
if {$basePath == "/"} {
|
||||
set node_path /$arg_array(path)
|
||||
} else {
|
||||
set node_path $basePath/$arg_array(path)
|
||||
}
|
||||
# }
|
||||
return $node_path
|
||||
}
|
||||
# if {[info exists arg_array(prop_list)]} {
|
||||
foreach {prop pval} $arg_array(prop_list) {
|
||||
hsetprop $node_path $prop $pval
|
||||
}
|
||||
# }
|
||||
return $node_path
|
||||
}
|
||||
|
||||
if {![info exists arg_array(dlen)]} {
|
||||
set arg_array(dlen) ""
|
||||
}
|
||||
set gp_path [file dirname $arg_array(node)]
|
||||
set node_name [file tail $arg_array(node)]
|
||||
if {$gp_path != "."} {
|
||||
add_hpath $basePath $gp_path
|
||||
set basePath $basePath/$gp_path
|
||||
hsetprop $basePath type part
|
||||
}
|
||||
if {[lsearch [hlist $basePath] $node_name] == -1} {
|
||||
#TODO allow hdb nodes of type drivable countable environment
|
||||
array set attribute [attlist $node_name]
|
||||
switch $arg_array(kind) {
|
||||
command {
|
||||
# A command is a macro, node=macro name
|
||||
set command $node_name
|
||||
set cmd_path [add_command $basePath $command]
|
||||
set node_path $cmd_path
|
||||
# The extra arguments for add_node are supplied by the command parameters
|
||||
# and command feedback procedures.
|
||||
if {[string length [info procs ${command}_parameters]] > 0} {
|
||||
${command}_parameters add_node $cmd_path
|
||||
} else {
|
||||
$command -map param ::hdb::add_cmd_par $cmd_path
|
||||
if {![info exists arg_array(dlen)]} {
|
||||
set arg_array(dlen) ""
|
||||
}
|
||||
set gp_path [file dirname $arg_array(node)]
|
||||
set node_name [file tail $arg_array(node)]
|
||||
if {$gp_path != "."} {
|
||||
add_hpath $basePath $gp_path
|
||||
set basePath $basePath/$gp_path
|
||||
hsetprop $basePath type part
|
||||
}
|
||||
if {[lsearch [hlist $basePath] $node_name] == -1} {
|
||||
#TODO allow hdb nodes of type drivable countable environment
|
||||
array set attribute [attlist $node_name]
|
||||
switch $arg_array(kind) {
|
||||
command {
|
||||
# A command is a macro, node=macro name
|
||||
set command $node_name
|
||||
set cmd_path [add_command $basePath $command]
|
||||
set node_path $cmd_path
|
||||
# The extra arguments for add_node are supplied by the command parameters
|
||||
# and command feedback procedures.
|
||||
if {[string length [info procs ${command}_parameters]] > 0} {
|
||||
${command}_parameters add_node $cmd_path
|
||||
} else {
|
||||
$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} {
|
||||
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
|
||||
hobj {
|
||||
hattach $basePath $node_name $arg_array(long_name)
|
||||
set node_path $basePath/$arg_array(long_name)
|
||||
hsetprop $node_path data [getatt $node_name data]
|
||||
hsetprop $node_path control [getatt $node_name control]
|
||||
hsetprop $node_path nxsave [getatt $node_name nxsave]
|
||||
hsetprop $node_path mutable [getatt $node_name mutable]
|
||||
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 {
|
||||
hattach $basePath $node_name $arg_array(long_name)
|
||||
set node_path $basePath/$arg_array(long_name)
|
||||
hsetprop $node_path data [getatt $node_name data]
|
||||
hsetprop $node_path control [getatt $node_name control]
|
||||
hsetprop $node_path nxsave [getatt $node_name nxsave]
|
||||
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]
|
||||
if {[info exists attribute(units)]} {
|
||||
hsetprop $node_path units $attribute(units)
|
||||
}
|
||||
if {[info exists arg_array(prop_list)]} {
|
||||
foreach {prop pval} $arg_array(prop_list) {
|
||||
hsetprop $node_path $prop $pval
|
||||
}
|
||||
}
|
||||
script {
|
||||
# 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 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)
|
||||
}
|
||||
sicslist setatt $node_name hdb_path $node_path
|
||||
return $node_path
|
||||
}
|
||||
if {[info exists attribute(units)]} {
|
||||
hsetprop $node_path units $attribute(units)
|
||||
}
|
||||
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
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
@ -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] {
|
||||
lappend atts [split [string range $att 0 end-1] =]
|
||||
if [ catch {
|
||||
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]
|
||||
sicslist setatt $sobj id $sobj
|
||||
switch $sobjatt(type) {
|
||||
motor - configurablevirtualmotor {
|
||||
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}
|
||||
} 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 [ catch {
|
||||
array set sobjatt [attlist $sobj]
|
||||
sicslist setatt $sobj id $sobj
|
||||
switch $sobjatt(type) {
|
||||
motor - configurablevirtualmotor {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} 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} {
|
||||
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
|
||||
}
|
||||
} 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
|
||||
} 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 {
|
||||
# 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 {
|
||||
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
|
||||
}
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
proc ::hdb::write_poll {pollnode val} {
|
||||
hsetprop $pollnode poll_interval $val
|
||||
sicspoll intervall $pollnode $val
|
||||
}
|
||||
proc ::hdb::read_poll {pollnode} {
|
||||
return [getatt $pollnode]
|
||||
}
|
||||
|
||||
##
|
||||
@ -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] {
|
||||
array unset sobjatt
|
||||
array set sobjatt [attlist $sobj]
|
||||
if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} {
|
||||
sobjadd $hpath $sobj
|
||||
if [ catch {
|
||||
foreach {sobj} [sobjlist $sobjtype $given_klass] {
|
||||
array unset sobjatt
|
||||
array set sobjatt [attlist $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
|
||||
foreach {n v} $dictionary {
|
||||
array unset varr
|
||||
array set varr $v
|
||||
array unset property_array
|
||||
array set property_array $varr(property)
|
||||
add_node / path $n prop_list $varr(property)
|
||||
if {[info exists varr(sobj)]} {
|
||||
foreach {sicstype sobj_klass} $varr(sobj) {
|
||||
if [ catch {
|
||||
prune dictionary
|
||||
foreach {n v} $dictionary {
|
||||
array unset varr
|
||||
array set varr $v
|
||||
array unset property_array
|
||||
array set property_array $varr(property)
|
||||
add_node / path $n prop_list $varr(property)
|
||||
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
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -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]
|
||||
set arglist [lrange $args 1 end]
|
||||
set proc_name [namespace origin [lindex [info level 0] 0]]
|
||||
set det_width_mm [SplitReply [detector_active_width_mm]]
|
||||
set det_radius_mm [SplitReply [detector_radius_mm]]
|
||||
set deg_per_radian [SplitReply [deg_per_rad]]
|
||||
switch -- $opt {
|
||||
"-centres" - "-boundaries" - "-graph_type" {
|
||||
return [calc_axis $proc_name @none @none @none $opt $args]
|
||||
}
|
||||
"-arrayname" {
|
||||
set max_b [OAT_TABLE -get X_MAX]
|
||||
set min_b [OAT_TABLE -get X_MIN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $opt $arglist]
|
||||
}
|
||||
"-units" {
|
||||
return "degrees"
|
||||
}
|
||||
default {
|
||||
set max_b [OAT_TABLE -get X_MAX]
|
||||
set min_b [OAT_TABLE -get X_MIN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $args]
|
||||
if [ catch {
|
||||
set opt [lindex $args 0]
|
||||
set arglist [lrange $args 1 end]
|
||||
set proc_name [namespace origin [lindex [info level 0] 0]]
|
||||
set det_width_mm [SplitReply [detector_active_width_mm]]
|
||||
set det_radius_mm [SplitReply [detector_radius_mm]]
|
||||
set deg_per_radian [SplitReply [deg_per_rad]]
|
||||
switch -- $opt {
|
||||
"-centres" - "-boundaries" - "-graph_type" {
|
||||
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args]
|
||||
}
|
||||
"-arrayname" {
|
||||
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist]
|
||||
}
|
||||
"-units" {
|
||||
return "degrees"
|
||||
}
|
||||
default {
|
||||
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args]
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
set script_name ::histogram_memory::two_theta
|
||||
|
||||
@ -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"} {
|
||||
error_msg "Can't create a new file because the current file is still open"
|
||||
} elseif {$state(file,new) == "false"} {
|
||||
error_msg "This function should only be called when state(file,new) = true"
|
||||
}
|
||||
if [ catch {
|
||||
if {$state(file,open) == "true"} {
|
||||
error_msg "Can't create a new file because the current file is still open"
|
||||
} elseif {$state(file,new) == "false"} {
|
||||
error_msg "This function should only be called when state(file,new) = true"
|
||||
}
|
||||
|
||||
set file_format [SplitReply [SicsDataPostFix]]
|
||||
array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
|
||||
set nxdict_path [::nexus::gen_nxdict $nexusdic]
|
||||
if {$state(file,namestyle) == "scratch"} {
|
||||
dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
|
||||
} else {
|
||||
sicsdatanumber incr
|
||||
dataFileName [newFileName $file_format]
|
||||
set file_format [SplitReply [SicsDataPostFix]]
|
||||
array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
|
||||
set nxdict_path [::nexus::gen_nxdict $nexusdic]
|
||||
if {$state(file,namestyle) == "scratch"} {
|
||||
dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
|
||||
} else {
|
||||
sicsdatanumber incr
|
||||
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 state
|
||||
variable data_gp_path
|
||||
variable filetype_spec
|
||||
variable state
|
||||
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
|
||||
foreach child [hlist /] {
|
||||
if {[::utility::hgetplainprop /$child data] == "true"} {
|
||||
::nexus::savetree $child $point
|
||||
if [ catch {
|
||||
if {[info level]<2} {
|
||||
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"
|
||||
}
|
||||
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} {
|
||||
error_msg "save index must be an integer"
|
||||
} elseif {$point < 0} {
|
||||
error_msg "save index cannot be negative"
|
||||
}
|
||||
if [ catch {
|
||||
if {[string is integer $point] == 0} {
|
||||
error_msg "save index must be an integer"
|
||||
} 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 currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
|
||||
set currDataType [::utility::hgetplainprop $data_gp_path datatype]
|
||||
set dataTypeChanged [expr {$currFileType != $currDataType}]
|
||||
if {$currDataType == "UNKNOWN"} {
|
||||
error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
|
||||
}
|
||||
|
||||
if {$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
|
||||
}
|
||||
set isNewFile [expr {$state(file,new) == "true"}]
|
||||
set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
|
||||
set currDataType [::utility::hgetplainprop $data_gp_path datatype]
|
||||
set dataTypeChanged [expr {$currFileType != $currDataType}]
|
||||
if {$currDataType == "UNKNOWN"} {
|
||||
error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
|
||||
}
|
||||
|
||||
if {$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"} {
|
||||
nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
|
||||
set state(file,open) true
|
||||
}
|
||||
if [ catch {
|
||||
if {[info level]<2} {
|
||||
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"} {
|
||||
nxscript close
|
||||
set state(file,open) false
|
||||
set flist [split [SplitReply [dataFileName]] "/"]
|
||||
set fname [lindex $flist [expr [llength $flist] - 1] ]
|
||||
clientput "$fname updated" "event"
|
||||
}
|
||||
if [ catch {
|
||||
if {[info level]<2} {
|
||||
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) == "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] {
|
||||
array unset p_arr
|
||||
array set p_arr [::utility::hlistplainprop /$hpath/$child]
|
||||
if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
|
||||
return
|
||||
}
|
||||
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]"
|
||||
set ::errorInfo ""
|
||||
if [ catch {
|
||||
foreach child [hlist /$hpath] {
|
||||
array unset p_arr
|
||||
array set p_arr [::utility::hlistplainprop /$hpath/$child]
|
||||
if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
|
||||
return
|
||||
}
|
||||
::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} {
|
||||
global cfPath
|
||||
variable nxdictionary
|
||||
set nxdict_path $cfPath(nexus)/$nexusdic
|
||||
proc ::nexus::gen_nxdict {nexusdic} {
|
||||
global cfPath
|
||||
variable nxdictionary
|
||||
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
|
||||
sicslist setatt nxscript privilege internal
|
||||
# SICS data objects
|
||||
sicslist setatt nxscript_data privilege internal
|
||||
if [ catch {
|
||||
# SICS commands
|
||||
sicslist setatt nxscript privilege internal
|
||||
# SICS data objects
|
||||
sicslist setatt nxscript_data privilege internal
|
||||
|
||||
foreach sobj [lrange [sicslist type motor] 1 end] {
|
||||
sicslist setatt $sobj savecmd ::nexus::motor::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type configurablevirtualmotor] {
|
||||
sicslist setatt $sobj savecmd ::nexus::motor::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type histmem] {
|
||||
sicslist setatt $sobj savecmd ::nexus::histmem::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type sicsvariable] {
|
||||
sicslist setatt $sobj savecmd ::nexus::sicsvariable::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type singlecounter] {
|
||||
sicslist setatt $sobj savecmd ::nexus::singlecounter::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type environment_controller] {
|
||||
sicslist setatt $sobj savecmd ::nexus::environment_controller::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist kind script] {
|
||||
sicslist setatt $sobj savecmd ::nexus::script::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
|
||||
foreach sobj [lrange [sicslist type motor] 1 end] {
|
||||
sicslist setatt $sobj savecmd ::nexus::motor::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type configurablevirtualmotor] {
|
||||
sicslist setatt $sobj savecmd ::nexus::motor::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type histmem] {
|
||||
sicslist setatt $sobj savecmd ::nexus::histmem::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type sicsvariable] {
|
||||
sicslist setatt $sobj savecmd ::nexus::sicsvariable::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type singlecounter] {
|
||||
sicslist setatt $sobj savecmd ::nexus::singlecounter::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist type environment_controller] {
|
||||
sicslist setatt $sobj savecmd ::nexus::environment_controller::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
|
||||
}
|
||||
foreach sobj [sicslist kind script] {
|
||||
sicslist setatt $sobj savecmd ::nexus::script::save
|
||||
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]
|
||||
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
|
||||
if [ catch {
|
||||
array set attribute [attlist $script]
|
||||
if {$attribute(klass) == "sensor"} {
|
||||
if {[lindex $args 0] == "point"} {
|
||||
set index [lindex $args 1]
|
||||
nxscript_data clear
|
||||
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)]} {
|
||||
nxscript putattribute $nxalias units $attribute(units)
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
proc ::nexus::script::sdsinfo {script data_type args} {
|
||||
array set param $args
|
||||
set dtype [::nexus::hdb2nx_type $data_type]
|
||||
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}"
|
||||
if [ catch {
|
||||
array set param $args
|
||||
set dtype [::nexus::hdb2nx_type $data_type]
|
||||
if {[getatt $script klass] == "sensor"} {
|
||||
if {$param(mutable) == true} {
|
||||
return " -type $dtype -rank 1 -dim {-1}"
|
||||
} else {
|
||||
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 {
|
||||
##
|
||||
# @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
|
||||
# index for nexus data sets which correspond to mutable data
|
||||
command gumtree_save {int: run_number} {
|
||||
::nexus::save $run_number
|
||||
}
|
||||
sicslist setatt ::data::gumtree_save long_name save
|
||||
array set param [::data::gumtree_save -list param]
|
||||
::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false
|
||||
command gumtree_type {text:nx.hdf,xml type} {
|
||||
SicsDataPostFix $type
|
||||
}
|
||||
sicslist set ::data::gumtree_type long_name file_format
|
||||
::data::gumtree_type -set type [SplitReply [SicsDataPostFix]]
|
||||
}
|
||||
#namespace eval data {
|
||||
# ##
|
||||
# # @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
|
||||
# # index for nexus data sets which correspond to mutable data
|
||||
# command gumtree_save {int: run_number} {
|
||||
# ::nexus::save $run_number
|
||||
# }
|
||||
# sicslist setatt ::data::gumtree_save long_name save
|
||||
# array set param [::data::gumtree_save -list param]
|
||||
# ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false
|
||||
# command gumtree_type {text:nx.hdf,xml type} {
|
||||
# SicsDataPostFix $type
|
||||
# }
|
||||
# sicslist set ::data::gumtree_type long_name file_format
|
||||
# ::data::gumtree_type -set type [SplitReply [SicsDataPostFix]]
|
||||
#}
|
||||
|
||||
::nexus::init
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
#!/bin/sh
|
||||
# $Revision: 1.26 $
|
||||
# $Date: 2008-05-29 04:57:42 $
|
||||
# $Revision: 1.27 $
|
||||
# $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
|
||||
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' WOMBAT - CONTROLLER 1
|
||||
'
|
||||
' $Revision: 1.10 $
|
||||
' $Date: 2008-04-13 23:50:38 $
|
||||
' $Revision: 1.11 $
|
||||
' $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
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' WOMBAT - CONTROLLER 2
|
||||
'
|
||||
' $Revision: 1.6 $
|
||||
' $Date: 2008-03-07 05:12:47 $
|
||||
' $Revision: 1.7 $
|
||||
' $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
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' WOMBAT - CONTROLLER 3
|
||||
'
|
||||
' $Revision: 1.4 $
|
||||
' $Date: 2008-03-07 05:12:47 $
|
||||
' $Revision: 1.5 $
|
||||
' $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
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' WOMBAT - CONTROLLER 4
|
||||
'
|
||||
' $Revision: 1.3 $
|
||||
' $Date: 2008-03-07 05:12:47 $
|
||||
' $Revision: 1.4 $
|
||||
' $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
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
sics_ports.tcl
|
||||
script_validator_ports.tcl
|
||||
instrument_vars.tcl
|
||||
wombat_configuration.tcl
|
||||
config
|
||||
util
|
||||
|
||||
@ -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
|
||||
|
||||
16
site_ansto/instrument/hipd/config/anticollider/acscript.txt
Normal file
16
site_ansto/instrument/hipd/config/anticollider/acscript.txt
Normal file
@ -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}
|
||||
@ -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
|
||||
1
site_ansto/instrument/hipd/config/commands/commands.tcl
Normal file
1
site_ansto/instrument/hipd/config/commands/commands.tcl
Normal file
@ -0,0 +1 @@
|
||||
source $cfPath(commands)/commands_common.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} }
|
||||
}
|
||||
@ -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"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure oat_nyc_eff 512
|
||||
hmm configure oat_nxc_eff [expr 480*8 - 1]
|
||||
}
|
||||
::histogram_memory::_initialize
|
||||
::histogram_memory::two_theta -boundaries
|
||||
if [ catch {
|
||||
if {$::sim_mode == "true"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure stitch_nyc 512
|
||||
hmm configure stitch_nxc [expr 480*8 - 1]
|
||||
}
|
||||
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_width_mm 500
|
||||
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
|
||||
detector_active_height_mm 200
|
||||
detector_active_width_mm 500
|
||||
detector_radius_mm 700.0
|
||||
|
||||
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
|
||||
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
|
||||
# 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
|
||||
::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} {
|
||||
|
||||
@ -1,7 +1,8 @@
|
||||
# $Revision: 1.20 $
|
||||
# $Date: 2008-05-29 04:53:32 $
|
||||
# $Revision: 1.21 $
|
||||
# $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
|
||||
|
||||
3
site_ansto/instrument/hipd/instrument_vars.tcl
Normal file
3
site_ansto/instrument/hipd/instrument_vars.tcl
Normal file
@ -0,0 +1,3 @@
|
||||
VarMake deg_per_rad Float Internal
|
||||
deg_per_rad 57.29577951308232
|
||||
deg_per_rad lock
|
||||
4
site_ansto/instrument/hipd/script_validator_ports.tcl
Normal file
4
site_ansto/instrument/hipd/script_validator_ports.tcl
Normal file
@ -0,0 +1,4 @@
|
||||
set quieckport quieck-val-wombat
|
||||
set serverport server-val-wombat
|
||||
set interruptport interrupt-val-wombat
|
||||
set telnetport telnet-val-wombat
|
||||
@ -1,5 +1,5 @@
|
||||
# $Revision: 1.19 $
|
||||
# $Date: 2007-11-07 04:57:40 $
|
||||
# $Revision: 1.20 $
|
||||
# $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
|
||||
|
||||
########
|
||||
# Parameters set above the restore command will be clobbered by
|
||||
# the values in the status.tcl file
|
||||
restore
|
||||
source instrument_vars.tcl
|
||||
|
||||
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
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' ECHIDNA - CONTROLLER 1
|
||||
'
|
||||
' $Revision: 1.8 $
|
||||
' $Date: 2008-04-13 23:50:38 $
|
||||
' $Revision: 1.9 $
|
||||
' $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
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' ECHIDNA - CONTROLLER 2
|
||||
'
|
||||
' $Revision: 1.6 $
|
||||
' $Date: 2008-04-13 23:50:38 $
|
||||
' $Revision: 1.7 $
|
||||
' $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
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' ECHIDNA - CONTROLLER 3
|
||||
'
|
||||
' $Revision: 1.10 $
|
||||
' $Date: 2008-05-08 06:48:32 $
|
||||
' $Revision: 1.11 $
|
||||
' $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
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
' ECHIDNA - CONTROLLER 4
|
||||
'
|
||||
' $Revision: 1.10 $
|
||||
' $Date: 2008-04-30 01:56:22 $
|
||||
' $Revision: 1.11 $
|
||||
' $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
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
sics_ports.tcl
|
||||
script_validator_ports.tcl
|
||||
instrument_vars.tcl
|
||||
echidna_configuration.tcl
|
||||
config
|
||||
util
|
||||
|
||||
@ -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
|
||||
|
||||
18
site_ansto/instrument/hrpd/config/anticollider/acscript.txt
Normal file
18
site_ansto/instrument/hrpd/config/anticollider/acscript.txt
Normal file
@ -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}
|
||||
@ -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
|
||||
1
site_ansto/instrument/hrpd/config/commands/commands.tcl
Normal file
1
site_ansto/instrument/hrpd/config/commands/commands.tcl
Normal file
@ -0,0 +1 @@
|
||||
source $cfPath(commands)/commands_common.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} }
|
||||
}
|
||||
@ -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"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure oat_nyc_eff 1024
|
||||
hmm configure oat_nxc_eff 64
|
||||
}
|
||||
::histogram_memory::_initialize
|
||||
::histogram_memory::two_theta -boundaries
|
||||
if [ catch {
|
||||
if {$::sim_mode == "true"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure oat_nyc_eff 1024
|
||||
hmm configure oat_nxc_eff 64
|
||||
}
|
||||
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_width_mm 500
|
||||
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
|
||||
detector_active_height_mm 335
|
||||
detector_active_width_mm 500
|
||||
detector_radius_mm 1250.0
|
||||
|
||||
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
|
||||
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
|
||||
# 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
|
||||
::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} {
|
||||
|
||||
@ -1,7 +1,8 @@
|
||||
# $Revision: 1.23 $
|
||||
# $Date: 2008-05-29 04:54:06 $
|
||||
# $Revision: 1.24 $
|
||||
# $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
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# $Revision: 1.26 $
|
||||
# $Date: 2007-11-05 02:28:46 $
|
||||
# $Revision: 1.27 $
|
||||
# $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
|
||||
|
||||
########
|
||||
# Parameters set above the restore command will be clobbered by
|
||||
# the values in the status.tcl file
|
||||
restore
|
||||
source instrument_vars.tcl
|
||||
|
||||
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
|
||||
|
||||
@ -1,70 +1,6 @@
|
||||
# Put extra config info here.
|
||||
# Just some examples for now
|
||||
bmon_distance -1.0
|
||||
Title "precommissioning tests"
|
||||
Sample "No Sample"
|
||||
# Selected wavelength in Angstroms
|
||||
crystal_wavelength_A "0.0"
|
||||
crystal_type "Unknown"
|
||||
## LAKESHORE
|
||||
# @file Put extra configuration info here.
|
||||
#
|
||||
# NOTE TO DEVELOPERS,\n
|
||||
# Do not put this file name in the MANIFEST.TXT, it should not be automatically\n
|
||||
# deployed to an instrument.
|
||||
|
||||
#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
|
||||
9
site_ansto/instrument/hrpd/instrument_vars.tcl
Normal file
9
site_ansto/instrument/hrpd/instrument_vars.tcl
Normal file
@ -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
|
||||
|
||||
|
||||
|
||||
|
||||
4
site_ansto/instrument/hrpd/script_validator_ports.tcl
Normal file
4
site_ansto/instrument/hrpd/script_validator_ports.tcl
Normal file
@ -0,0 +1,4 @@
|
||||
set quieckport quieck-val-echidna
|
||||
set serverport server-val-echidna
|
||||
set interruptport interrupt-val-echidna
|
||||
set telnetport telnet-val-echidna
|
||||
@ -1,9 +1,10 @@
|
||||
' PLATYPUS - CONTROLLER 1
|
||||
'
|
||||
' $Revision: 1.11 $
|
||||
' $Date: 2008-04-30 01:57:55 $
|
||||
' $Revision: 1.12 $
|
||||
' $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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
' PLATYPUS - CONTROLLER 2
|
||||
'
|
||||
' $Revision: 1.6 $
|
||||
' $Date: 2008-04-30 01:57:55 $
|
||||
' $Revision: 1.7 $
|
||||
' $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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
' PLATYPUS - CONTROLLER 3
|
||||
'
|
||||
' $Revision: 1.6 $
|
||||
' $Date: 2008-04-30 01:57:55 $
|
||||
' $Revision: 1.7 $
|
||||
' $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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
' PLATYPUS - CONTROLLER 4
|
||||
'
|
||||
' $Revision: 1.6 $
|
||||
' $Date: 2008-04-30 01:57:55 $
|
||||
' $Revision: 1.7 $
|
||||
' $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
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
platypus_configuration.tcl
|
||||
sics_ports.tcl
|
||||
script_validator_ports.tcl
|
||||
extraconfig.tcl
|
||||
config
|
||||
util
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
@ -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
|
||||
@ -0,0 +1 @@
|
||||
source $cfPath(commands)/commands_common.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}
|
||||
}
|
||||
} ]
|
||||
|
||||
18
site_ansto/instrument/reflectometer/config/hmm/detector.tcl
Normal file
18
site_ansto/instrument/reflectometer/config/hmm/detector.tcl
Normal file
@ -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
|
||||
}
|
||||
|
||||
@ -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"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure oat_nyc_eff 210
|
||||
hmm configure oat_nxc_eff 210
|
||||
}
|
||||
::histogram_memory::_initialize
|
||||
if [ catch {
|
||||
if {$::sim_mode == "true"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure oat_nyc_eff 210
|
||||
hmm configure oat_nxc_eff 210
|
||||
}
|
||||
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_width_mm 500
|
||||
detector_active_height_mm 257.5
|
||||
detector_active_width_mm 500
|
||||
|
||||
set x_bb0 -210.5; set xbbmax 210.5
|
||||
set y_bb0 -110.5; set ybbmax 110.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
|
||||
# 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
|
||||
::histogram_memory::init_OAT_TABLE
|
||||
::histogram_memory::upload_config Filler_defaults
|
||||
|
||||
::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::vertical_axis ::histogram_memory::y_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 ] {
|
||||
return -code error $errmsg
|
||||
} message ] {
|
||||
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 -code error $errmsg
|
||||
return $reply
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
publish histmem user
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# $Revision: 1.14 $
|
||||
# $Date: 2007-10-31 06:07:10 $
|
||||
# $Revision: 1.15 $
|
||||
# $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
|
||||
|
||||
@ -0,0 +1,4 @@
|
||||
set quieckport quieck-val-platypus
|
||||
set serverport server-val-platypus
|
||||
set interruptport interrupt-val-platypus
|
||||
set telnetport telnet-val-platypus
|
||||
@ -1,10 +1,11 @@
|
||||
' KOWARI - CONTROLLER 1
|
||||
'
|
||||
' $Revision: 1.6 $
|
||||
' $Date: 2008-04-14 00:28:07 $
|
||||
' $Revision: 1.7 $
|
||||
' $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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
NO TE: KOWARI - CONTROLLER 3
|
||||
NO TE:
|
||||
NO TE: $Revision: 1.3 $
|
||||
NO TE: $Date: 2008-05-08 06:50:04 $
|
||||
NO TE: $Revision: 1.4 $
|
||||
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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
NO TE: KOWARI - CONTROLLER 4
|
||||
NO TE:
|
||||
NO TE: $Revision: 1.2 $
|
||||
NO TE: $Date: 2007-09-24 01:25:23 $
|
||||
NO TE: $Revision: 1.3 $
|
||||
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)
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
sics_ports.tcl
|
||||
script_validator_ports.tcl
|
||||
kowari_configuration.tcl
|
||||
extraconfig.tcl
|
||||
config
|
||||
|
||||
@ -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
|
||||
|
||||
10
site_ansto/instrument/rsd/config/anticollider/acscript.txt
Normal file
10
site_ansto/instrument/rsd/config/anticollider/acscript.txt
Normal file
@ -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} }
|
||||
@ -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
|
||||
1
site_ansto/instrument/rsd/config/commands/commands.tcl
Normal file
1
site_ansto/instrument/rsd/config/commands/commands.tcl
Normal file
@ -0,0 +1 @@
|
||||
source $cfPath(commands)/commands_common.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"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure oat_nyc_eff 421
|
||||
hmm configure oat_nxc_eff 421
|
||||
}
|
||||
::histogram_memory::_initialize
|
||||
if [ catch {
|
||||
if {$::sim_mode == "true"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure oat_nyc_eff 421
|
||||
hmm configure oat_nxc_eff 421
|
||||
}
|
||||
BAT_TABLE -init
|
||||
CAT_TABLE -init
|
||||
SAT_TABLE -init
|
||||
OAT_TABLE -init
|
||||
FAT_TABLE -init
|
||||
::histogram_memory::_initialize
|
||||
|
||||
detector_active_height_mm 500
|
||||
detector_active_width_mm 500
|
||||
# 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
|
||||
::histogram_memory::init_OAT_TABLE
|
||||
::histogram_memory::upload_config Filler_defaults
|
||||
|
||||
set x_bb0 -210.5; set xbbmax 210.5
|
||||
set y_bb0 -210.5; set ybbmax 210.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}]
|
||||
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
|
||||
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
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} {
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
# $Revision: 1.23 $
|
||||
# $Date: 2008-05-29 04:55:49 $
|
||||
# $Revision: 1.24 $
|
||||
# $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 29446192
|
||||
set stth_Home 28686300
|
||||
|
||||
#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\
|
||||
hardupperlim 120\
|
||||
hardlowerlim 30\
|
||||
hardupperlim 150\
|
||||
maxSpeed 0.5\
|
||||
maxAccel 0.1\
|
||||
maxDecel 0.1\
|
||||
stepsPerX 25000\
|
||||
absEnc 1\
|
||||
absEncHome $stth_Home\
|
||||
cntsPerX -8192]
|
||||
stth softlowerlim -90
|
||||
stth softupperlim 120
|
||||
stth home 0
|
||||
cntsPerX -93207]
|
||||
stth softlowerlim 30
|
||||
stth softupperlim 150
|
||||
stth home 90
|
||||
stth speed 0.5
|
||||
stth movecount $move_count
|
||||
stth precision 0.01
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# $Revision: 1.9 $
|
||||
# $Date: 2007-11-05 02:29:31 $
|
||||
# $Revision: 1.10 $
|
||||
# $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
|
||||
|
||||
4
site_ansto/instrument/rsd/script_validator_ports.tcl
Normal file
4
site_ansto/instrument/rsd/script_validator_ports.tcl
Normal file
@ -0,0 +1,4 @@
|
||||
set quieckport quieck-val-kowari
|
||||
set serverport server-val-kowari
|
||||
set interruptport interrupt-val-kowari
|
||||
set telnetport telnet-val-kowari
|
||||
@ -1,9 +1,10 @@
|
||||
NO TE: QUOKKA - CONTROLLER 1
|
||||
NO TE:
|
||||
NO TE: $Revision: 1.8 $
|
||||
NO TE: $Date: 2007-09-24 01:10:59 $
|
||||
NO TE: $Revision: 1.9 $
|
||||
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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
NO TE: QUOKKA - CONTROLLER 2
|
||||
NO TE:
|
||||
NO TE: $Revision: 1.5 $
|
||||
NO TE: $Date: 2007-09-24 01:10:59 $
|
||||
NO TE: $Revision: 1.6 $
|
||||
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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
NO TE: QUOKKA - CONTROLLER 3
|
||||
NO TE:
|
||||
NO TE: $Revision: 1.5 $
|
||||
NO TE: $Date: 2007-09-24 01:10:59 $
|
||||
NO TE: $Revision: 1.6 $
|
||||
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
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
NO TE: QUOKKA - CONTROLLER 4
|
||||
NO TE:
|
||||
NO TE: $Revision: 1.7 $
|
||||
NO TE: $Date: 2007-09-24 01:10:59 $
|
||||
NO TE: $Revision: 1.8 $
|
||||
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
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
quokka_configuration.tcl
|
||||
velsel.tcl
|
||||
sics_ports.tcl
|
||||
script_validator_ports.tcl
|
||||
extraconfig.tcl
|
||||
config
|
||||
util
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
@ -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
|
||||
65
site_ansto/instrument/sans/config/commands/commands.tcl
Normal file
65
site_ansto/instrument/sans/config/commands/commands.tcl
Normal file
@ -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"
|
||||
}
|
||||
}
|
||||
17
site_ansto/instrument/sans/config/hmm/detector.tcl
Normal file
17
site_ansto/instrument/sans/config/hmm/detector.tcl
Normal file
@ -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
|
||||
}
|
||||
|
||||
@ -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_width_mm 192
|
||||
detector_active_height_mm 257.5
|
||||
detector_active_width_mm 500
|
||||
|
||||
set x_bb0 -0.5; set xbbmax 191.5
|
||||
set y_bb0 -0.5; set ybbmax 191.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}]
|
||||
# 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
|
||||
::histogram_memory::init_OAT_TABLE
|
||||
::histogram_memory::upload_config Filler_defaults
|
||||
|
||||
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
|
||||
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
|
||||
} message ] {
|
||||
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} {
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
# $Revision: 1.15 $
|
||||
# $Date: 2008-02-19 04:27:19 $
|
||||
# $Revision: 1.16 $
|
||||
# $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
|
||||
}
|
||||
}
|
||||
|
||||
@ -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 }
|
||||
MT {MT MT MT MT MT MT MT MT MT }
|
||||
LP {MT MT MT MT MT MT MT MT LP }
|
||||
LENS {MT MT MT MT MT MT MT MT L }
|
||||
P1 {P A MT MT MT MT MT MT MT }
|
||||
P1LP {P A MT MT MT MT MT MT LP }
|
||||
P1LENS {P A MT MT MT MT MT MT L }
|
||||
G1 {G A MT 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 }
|
||||
P3 {P 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 }
|
||||
G4 {G G G G A MT MT MT MT }
|
||||
P5 {P 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 }
|
||||
G6 {G G G G G G A MT MT }
|
||||
P7 {P 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 }
|
||||
G8 {G G G G G G G G A }
|
||||
P9 {P G G G G G G G G }
|
||||
G9 {G G G G G G G G G }
|
||||
ga {MT A A A A A A A A }
|
||||
mt {MT MT MT MT MT MT MT MT MT }
|
||||
lp {MT MT MT MT MT MT MT MT LP }
|
||||
lens {MT MT MT MT MT MT MT MT L }
|
||||
p1 {P A MT MT MT MT MT MT MT }
|
||||
p1lp {P A MT MT MT MT MT MT LP }
|
||||
p1lens {P A MT MT MT MT MT MT L }
|
||||
g1 {G A MT 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 }
|
||||
p3 {P 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 }
|
||||
g4 {G G G G A MT MT MT MT }
|
||||
p5 {P 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 }
|
||||
g6 {G G G G G G A MT MT }
|
||||
p7 {P 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 }
|
||||
g8 {G G G G G G G G A }
|
||||
p9 {P 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
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user