/* @(#)tbcopyk.c	17.1.1.1 (ES0-DMD) 01/25/02 17:47:11 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.TYPE        Module
.NAME        tbcopyk.c
.LANGUAGE    C
.AUTHOR      IPG-ESO Garching
.CATEGORY    table utilities / table <=> keyword

.COMMENTS
\begin{TeX}

Copy keyword into table entry(s).
If columns are not defined in the command, the full table row
is copied into the keyword. 
This command is equivalent to the MCL statement
keyword = table,column,row 

\begin{enumerate}
\item {\tt COPY/KT} keyword table column\_selection line\_number
	\begin{description}
	\item[p1]    input keyword.
	\item[p2]    table name.
	\item[p3--pj] column reference(s).
	\item[pj+1]  entry (row) number.
	\end{description}

\item {\tt COPY/TK} table column\_selection line\_number keyword 
	\begin{description}
	\item[p1]    table name.
	\item[p2--pj] column reference(s).
	\item[pj+1]  entry (row) number.
	\item[pj+2]  output keyword.
	\end{description}
\end{enumerate}

\end{TeX}


.VERSION 1.0 	25-Mar-1990   Definition     J.D. Ponz
.VERSION 1.1 	07-Jun-1990                  M. Peron
.VERSION 3.0 	05-Jul-1990   New version with column arrays   F.O.
				Merged tbcopytk / tbcopykt 
------------------------------------------------------------*/

#include <ctype.h>
#include <tbldef.h>
#include <midas_def.h>
#include <str.h>		/* String Utilities	*/
#include <macrogen.h>		/* e.g. MIN / MAX	*/
#include <proto_tbl.h>

#define STRINGLEN 256
#define PARLEN    80
#define NCOL      10

static int unit = 0;

static get_keywd (text, ktype, kstart, kitems)
/*++++++++++++++++++
.PURPOSE Interpret the keyword/type/start/items
.RETURNS ---
------------------*/
	char	*text;	 	/* MOD: Text to interpret */
	int	*ktype; 	/* OUT: Datatype	*/
	int	*kstart;	/* OUT: First element	*/
	int	*kitems;	/* OUT: How many	*/
{
	int	i;
	char	*p;
	
  text[strloc(text, ' ')] = '\0';	/* No blank allowed	*/
  i = strloc (text, '/');

  *ktype  = D_R4_FORMAT;
  *kstart = 1;
  *kitems = 1;  

  p = text + i;
  if (*p) {				/* decode keyword type...*/
	*(p++) = '\0';
  	switch (toupper(*p)) {
	  case 'C': *ktype = D_C_FORMAT;  break;
	  case 'I': *ktype = D_I4_FORMAT; break;
	  case 'D': *ktype = D_R8_FORMAT; break;
	  default : *ktype = D_R4_FORMAT; break;
	}
	if (*++p == '/') {
		*kstart = atoi (++p);
                i = strloc(p,'/');
                if (p[i])
                   { p = p+i;
                     *kitems = atoi(++p);
                   }
/*		if (*++p == '/')  *kitems = atoi (++p); */
	}
  }
  if ((*kitems > NCOL) && (*ktype != D_C_FORMAT)) {
	SCTPUT ("++++ Elements of Keyword Restricted");
	*kitems = NCOL;
  }
}

tbl_copykt()
/*++++++++++++++++++
.PURPOSE COPY/KT keyword table [:column] element 
.RETURNS Status
------------------*/
{
  char   table[PARLEN], keyw[PARLEN], line[STRINGLEN];
  char   msg[100];
  int  	 tid, ncol, dummy, found;
  int    i, status, irow;
  int   dtype, ktype, items, istart, nval, npar;
  int   nctable, nrtable, nsc, nar,  nac;
  int   ibuf[NCOL], icol[NCOL];
  float  rbuf[NCOL];
  double dbuf[NCOL], atof();

  npar = tbl_argc();
  
  if (npar < 4) {
  	SCTPUT("Wrong number of parameters");
	return (ERR_INPINV);
  }
						/* read parameter */
  tbl_getarg(2, PARLEN, table);
						/* open tablefile */
  status = TCTOPN(table, F_EIO_FORCE|F_IO_MODE, &tid);
  if (status != ERR_NORMAL) {
  	SCTPUT("Error opening the table");
	return (status);
  }
  TCIGET(tid,&nctable,&nrtable,&nsc,&nac,&nar); 
						/* read keyword */
  tbl_getarg(1, PARLEN, keyw);
  get_keywd (keyw, &ktype, &istart, &nval);
    
						/* read row */
  tbl_getarg(npar, PARLEN, line);
  if (status = tbl_getrows(line, tid, 1, &irow, &irow, &found))
  	return(status);
  if(irow > nar)
    {
     status = ERR_TBLROW;
     sprintf (msg, "Row selection outside range[1..%d]",nar);
     SCTPUT(msg);
     return(status);
     }
						/* read column */
  ncol = 0;
  status = ERR_NORMAL;
  for (i=3; (status == ERR_NORMAL) && (i<npar); i++) {
	tbl_getarg(i, PARLEN, line);
	status = TCCSEL(tid, line, NCOL - ncol, 
		&icol[ncol], &ibuf[ncol], &found);
	if (status) {
		SCTPUT("Column(s) not found");
		return(status);
	}
	else 	ncol += found;
  }

  if (ncol == 0) {
	ncol = 1; icol[0] = 1;
  	if (ktype != D_C_FORMAT) {
		ncol = nval;
		for (i=0; i< ncol; i++) icol[i] = i+1;
	}
  }
  
					/* Check columns are not arrays ... */
  for (i=0; i< ncol; i++) {
	TCBGET (tid, icol[i], &dtype, &items, &dummy);
	if ((items > 1) && (dtype != D_C_FORMAT)) 
		SCTPUT ("++++ Only first element used in array columns");
  }
					/* copy from key into table */
  switch(ktype) {
    case D_I4_FORMAT: 
    	SCKRDI(keyw, istart, nval, &found, ibuf, &unit, &dummy);
	TCRWRI(tid, irow, found, icol, ibuf);
	break;   
    case D_R4_FORMAT: 
    	SCKRDR(keyw, istart, nval, &found, rbuf, &unit, &dummy);
	TCRWRR(tid, irow, nval, icol, rbuf);
	break;   
    case D_R8_FORMAT: 
    	SCKRDD(keyw, istart, nval, &found, dbuf, &unit, &dummy);
	TCRWRD(tid, irow, nval, icol, dbuf);
	break;   
    case D_C_FORMAT:  
    	SCKRDC(keyw, 1, istart, nval, &found, line, &unit, &dummy);
	TCEWRC(tid, irow, icol[0], line);
	break;   
  }

  TCTCLO(tid);   
   
  return (status);
}       


tbl_copytk()
/*++++++++++++++++++
.PURPOSE COPY/TK table [:col] element keyword
.RETURNS Status
------------------*/
{
  char   table[PARLEN], keyw[PARLEN], line[STRINGLEN];
  int  	 tid, ncol, dummy, found;
  int    i, status, irow, sel;
  int    dtype, ktype, items, istart, nval, npar;
  int    ibuf[NCOL], icol[NCOL], inull[NCOL];
  float  rbuf[NCOL];
  double dbuf[NCOL], atof();

  npar = tbl_argc();
  
  if (npar < 4) {
  	SCTPUT("Wrong number of parameters");
	return (ERR_INPINV);
  }

						/* open tablefile */
  tbl_getarg(1, PARLEN, table);
  status = TCTOPN(table, F_EIO_FORCE|F_I_MODE, &tid);
  if (status != ERR_NORMAL) {
  	SCTPUT("Error opening the table");
	return (status);
  }
  
						/* read keyword */
  tbl_getarg(npar, PARLEN, keyw);
  get_keywd (keyw, &ktype, &istart, &nval);
  

						/* read row */
  tbl_getarg(--npar, PARLEN, line);
  if (status = tbl_getrows(line, tid, 1, &irow, &irow, &found))
  	return(status);
  TCSGET(tid, irow, &sel);

  if (!sel) {
  	SCTPUT("Entry not selected");
	return(ERR_TBLROW);
  }

						/* read column */
  ncol = 0;
  status = ERR_NORMAL;
  for (i=2; (status == ERR_NORMAL) && (i<npar); i++) {
	tbl_getarg(i, PARLEN, line);
	status = TCCSEL(tid, line, NCOL - ncol, 
		&icol[ncol], &ibuf[ncol], &found);
	if (status) {
		SCTPUT("Column(s) not found");
		return(status);
	}
	else 	ncol += found;
  }

  if (ncol == 0) {
	ncol = 1; icol[0] = 1;
  	if (ktype != D_C_FORMAT) {
		ncol = nval;
		for (i=0; i< ncol; i++) icol[i] = i+1;
	}
  }

					/* Check columns are not arrays ... */
  for (i=0; i< ncol; i++) {
	TCBGET (tid, icol[i], &dtype, &items, &dummy);
	if ((items > 1) && (dtype != D_C_FORMAT)) 
		SCTPUT ("++++ Only first element used in array columns");
  }

					/* read table, write keyword */
  switch(ktype) {
    case D_I4_FORMAT: 
	TCRRDI(tid,irow,ncol,icol,ibuf,inull);
	SCKWRI(keyw, ibuf, istart, nval, &unit);
	break;   
    case D_R4_FORMAT: 
	TCRRDR(tid,irow,ncol,icol,rbuf,inull);
	SCKWRR(keyw, rbuf, istart, nval, &unit);
	break;   
    case D_R8_FORMAT: 
	TCRRDD(tid,irow,ncol,icol,dbuf,inull);
	SCKWRD(keyw, dbuf, istart, nval, &unit);
	break;   
    case D_C_FORMAT:  
    	TCERDC(tid, irow ,icol[0], line, inull);
	for (i = strlen(line); i<nval; i++) 	line[i] = ' ';
	SCKWRC(keyw, 1, line, istart, nval, &unit);
	break;   
  }

  TCTCLO(tid);   
   
  return (status);
}