Commit 67b74e6b authored by mnb's avatar mnb Committed by afarrell
Browse files

Added new tcl command ptr2data which is a flexible extension of the fitstcl command ptr2lst

	Added tcl command ptr2data; flexible ext of fitstcl command ptr2lst
parent 1847e90d
......@@ -37,3 +37,6 @@ void pgsubp_(int* i1, int* i2);
void pgtext_(float* x,float* y,char* txt,unsigned long l3);
void pgvsiz_(float* x1,float* x2,float* x3,float* x4);
void pgwnad_(float* x1,float* x2,float* x3,float* x4);
int lmerge(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[]);
......@@ -166,6 +166,12 @@ void pgsubp_(int* i1, int* i2);
void pgtext_(float* x,float* y,char* txt,unsigned long l3);
void pgvsiz_(float* x1,float* x2,float* x3,float* x4);
void pgwnad_(float* x1,float* x2,float* x3,float* x4);
int lmergeCmd(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[]);
int ptr2dataCmd(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[]);
/* ------------- END HEADER FILE CONTENTS ------------------ */
......@@ -173,6 +179,12 @@ void pgwnad_(float* x1,float* x2,float* x3,float* x4);
int Pgplot_tcl_Init(Tcl_Interp *interp)
{
Tcl_CreateCommand(interp,"lmerge",(Tcl_CmdProc *)lmergeCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateCommand(interp,"ptr2data",(Tcl_CmdProc *)ptr2dataCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateCommand(interp,"pgcent",(Tcl_CmdProc *)pgcentCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
......
......@@ -131,6 +131,7 @@ int fortran_cmd_(int* n);
/* nswc routines most commonly used */
void ishell_(int* a, int* n);
void shell_(float* a,int* n);
void qsorti_(int* a,int* idx,int* n);
......@@ -170,11 +171,299 @@ void pgsubp_(int* i1, int* i2);
void pgtext_(float* x,float* y,char* txt,unsigned long l3);
void pgvsiz_(float* x1,float* x2,float* x3,float* x4);
void pgwnad_(float* x1,float* x2,float* x3,float* x4);
int lmergeCmd(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[]);
int ptr2dataCmd(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[]);
/* ------------- END HEADER FILE CONTENTS ------------------ */
/*---------------------------------------------------------------------*/
/* -----------------------------------------------------------------------*/
/* lmergeCmd */
/* -----------------------------------------------------------------------*/
/* An extension to the tcl list commands.
Will input 2 lists eg.
list1= {a b c d} and list2={1 2 3 4}
and will create a new list that is a merger of the two in alternate
sequence, eg,
lmerge $list1 $list2 = {a 1 b 2 c 3 d 4}
*/
int lmergeCmd(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[])
{
int list1Rc, list2Rc;
const char **list1Rv,**list2Rv;
int i;
if (argc<2) return TCL_ERROR;
/* Split the first List of Double Value Strings values*/
if (Tcl_SplitList(interp, argv[1], &list1Rc, &list1Rv) != TCL_OK) {
return TCL_ERROR;
};
/* Split the second List of Double Value Strings values*/
if (Tcl_SplitList(interp, argv[2], &list2Rc, &list2Rv) != TCL_OK) {
return TCL_ERROR;
};
if (list1Rc!=list2Rc) {return TCL_ERROR;}
/* Define return value as a merger of the two lists*/
for (i=0;i<list1Rc;i++)
{
Tcl_AppendElement(interp,list1Rv[i]);
Tcl_AppendElement(interp,list2Rv[i]);
}
return TCL_OK;
}
/* -----------------------------------------------------------------------*/
/* ptr2dataCmd */
/* -----------------------------------------------------------------------*/
/* An extension to the fitstcl ptr2lst command in that it will return */
/* data values direct from memory in a miriad of options */
/*
ptr2data dat [row] [col] Return value of cell
ptr2data col [col] Return entire column as a tcl list
ptr2data row [row] Return entire row as a tcl list
ptr2data ri [row] Return entire row as an indexed list
ptr2data ci [col] Return entire col as an indexed list
ptr2data sr [row] [col1] [col2] Return sum of row from col1 to col2
ptr2data mr [row] [col1] [col2] Return median of row from col1 to col2
Note: cnvtForFitsNan is a temporary hack as we do not know what represents the
nan values at this stage.
*/
float cnvtForFitsNan(float *gf)
{
float f;
f=*gf;
if (isnan(f)) {f=0.0;}
if (isinf(f)) {f=0.0;}
if (f> 8000000.0) {f=0.0;}
if (f<-1000000.0) {f=0.0;}
*gf=f;
}
int ptr2dataCmd(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[])
{
void *theptr;
float f;
float fv[10];
int i;
float sum, median;
int col1,col2, n, idx;
float *sortV;
int *idxV;
int nrows,ncols;
int req_i,req_j,req_row,req_col;
char buffer[100];
union {
unsigned char *byte;
short *shrt;
int *lng;
float *flt;
double *dbl;
void *ptr;
} ptrs;
/* Must have at least 5 arguments ptr string, ncols and nrows*/
if (argc<=5) return TCL_ERROR;
/*Translate ptr string into a pointer we can use (see fitstcl guide)*/
sscanf(argv[2],"%p",&theptr);
/* Get the array size*/
Tcl_GetInt(interp,argv[3],&ncols);
Tcl_GetInt(interp,argv[4],&nrows);
/* Switch on choice if the argv[1] string*/
if (argv[1][0]=='r') {
/* Return row data as tcl list*/
Tcl_GetInt(interp,argv[5],&req_row);
idx=(req_row-1)*ncols;
ptrs.ptr=theptr;
ptrs.ptr=ptrs.ptr+idx*sizeof(float);
for( i=0; i<ncols; i++) {
/*If arg[1] is "ri" then add row index first*/
if (argv[1][1]=='i') {
sprintf(buffer,"%f",(float)(i+1));
Tcl_AppendElement(interp,buffer);
}
f=(float)*ptrs.flt;
cnvtForFitsNan(&f);
sprintf(buffer,"%f",f);
Tcl_AppendElement(interp,buffer);
ptrs.flt++ ;
}
return TCL_OK;
} else if (argv[1][0]=='s') {
/* Return summation of row data. Must have 7 args*/
if (argc<=7) return TCL_ERROR;
Tcl_GetInt(interp,argv[5],&req_row);
Tcl_GetInt(interp,argv[6],&col1);
Tcl_GetInt(interp,argv[7],&col2);
if (col1<1) col1=1;
if (col2>ncols) col2=ncols;
idx=(req_row-1)*ncols;
ptrs.ptr=theptr;
ptrs.ptr=ptrs.ptr+idx*sizeof(float);
sum=0.0;
for( i=col1-1; i<col2; i++) {
f=(float)*ptrs.flt;
cnvtForFitsNan(&f);
sum=sum+f;
ptrs.flt++ ;
}
sprintf(interp->result,"%f",sum);
return TCL_OK;
} else if (argv[1][0]=='m') {
/* Return median of row data. Must have 7 args*/
if (argc<=7) return TCL_ERROR;
Tcl_GetInt(interp,argv[5],&req_row);
Tcl_GetInt(interp,argv[6],&col1);
Tcl_GetInt(interp,argv[7],&col2);
if (col1<1) col1=1;
if (col2>ncols) col2=ncols;
idx=(req_row-1)*ncols;
ptrs.ptr=theptr;
ptrs.ptr=ptrs.ptr+idx*sizeof(float);
n=col2-col1+1;
sortV=malloc(n*sizeof(float));
idx=0;
for( i=col1-1; i<col2; i++) {
f=(float)*ptrs.flt;
cnvtForFitsNan(&f);
sortV[idx]=f;
idx=idx+1;
ptrs.flt++ ;
}
n=idx;
shell_(sortV,&n);
idx=(int)(0.5*n);
median=sortV[idx];
sprintf(interp->result,"%f",median);
return TCL_OK;
} else if (argv[1][0]=='c') {
/* Return col data as tcl list*/
Tcl_GetInt(interp,argv[5],&req_col);
idx=(req_col-1);
ptrs.ptr=theptr;
ptrs.ptr=ptrs.ptr+idx*sizeof(float);
for( i=0; i<nrows; i++) {
f=(float)*ptrs.flt;
sprintf(buffer,"%f",f);
Tcl_AppendElement(interp,buffer);
/*If arg[1] is "ci" then add col index as well*/
if (argv[1][1]=='i') {
sprintf(buffer,"%f",(float)(i+1));
Tcl_AppendElement(interp,buffer);
}
ptrs.ptr=ptrs.ptr+ncols*sizeof(float);
}
return TCL_OK;
}
/* Default return the data value of specified cell. Must have 6 args*/
if (argc<=6) return TCL_ERROR;
Tcl_GetInt(interp,argv[5],&req_i);
Tcl_GetInt(interp,argv[6],&req_j);
idx=(req_i-1)*ncols+(req_j-1);
ptrs.ptr=theptr;
ptrs.ptr=ptrs.ptr+idx*sizeof(float);
f=(float)*ptrs.flt;
sprintf(interp->result,"%f",f);
return TCL_OK;
}
/*---------------------------------------------------------------------*/
/*---------------------------------------------------------------------*/
/* Tcl Wrappers to pgplot commands */
/*---------------------------------------------------------------------*/
/*---------------------------------------------------------------------*/
int GrexecCmd(ClientData clientData,
Tcl_Interp *interp,
int argc, char *argv[])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment