/*===========================================================================
  Copyright (C) 1995-2013 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 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence 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
===========================================================================*/

/*++++++++++++++
..IDENTIFICATION tca.c
..LANGUAGE       C
..AUTHOR         ESO-IPG, Garching
..ENVIRONMENT    Midas
..KEYWORDS       Table (3-D) Interfaces
..COMMENTS       
\begin{TeX}

This module contains the routines to handle the access to table
elements, which { \em can be arrays }.
Access to elements is done by column, row and index numbers; 
an array of elements is specified by column, row, index and length.
The length is taken as the maximum possible when this argument is zero.
element arrays in the table can be integer (I*1, i*2 or I*4), float, 
double precision or character string data types, 
as defined during the creation of the columns. 
Implicit conversion of the element value is done automatically if the
input/output is done with a routine not corresponding to the data type.

The functions provided by this module are:

\begin{itemize}
\item Delete an array element (TCADEL),
\item read an extract of an array element from the table (TCARD$x$),
\item map an array element of the table (TCAMAP),
\item write an extract of an array element into the table (TCAWR$x$),
%\item search for an element value (TCASR$x$).
\item unmap an element of the table (TCAUNM),
\end{itemize}

Main arguments used by the routines are:
\begin{description}
\item[col] sequential column number. It is an integer number provided
           by the system when a new column is created, or it is defined by 
           the user for already existing columns.
\item[index] starting position in the element array. The first element
	is numbered 1.
\item[items] How many elements of the array are concerned. The value
	0 stands for {\em all}
\item[null] null flag. This value is 1 if the element is undefined,
           0 otherwise.
\item[row] sequential row number. It is an integer defining 
           the row number in the table or the symbols LAST, FIRST, NEXT 
           and PREVIOUS defined in the system file 'midas\_def.h' in the
           directory 'MID\_INCLUDE'. 
           The sequence number is the physical sequence number (by default)
           or the sequence corresponding to the index of the reference 
           column.
\item[tid] table identifier. It is an integer number provided by the
           system when the table is created or opened.
\item[value] element value. The type depends on the routine name.
           Implicit conversion is done if this type does not correspond
           to the column data type.
\end{description}

\end{TeX}

..VERSION  1.0   14-Dec-1990: Creation (Francois Ochsenbein)

 130702		last modif
---------------*/

#include <midas_def.h>		/* General MIDAS Symbols	*/
#include <tblsys.h>		/* Table System parameters	*/
#include <tbldef.h>		/* Symbols used for Tables	*/
#include <tblerr.h>		/* List of Table Errors		*/

#include <atype.h>		/* Character classification	*/
#include <macrogen.h>		/* Classical macros		*/

#include <math.h>		/* System Library		*/

#include <stdlib.h>



char  *TBL_RDF();

	/* Variables shared by the programs: */

static int map_arg = TBL__MAPPED;
 
static int esize;		/* size of table element */
static int eoffs;		/* offset into table */
static int bytes;		/* no. of bytes to work on */

 
	/* Mnemonics for some operations */
	

#define CheckRowPositive(row)	(row < 1 ? ERR_TBLROW : ERR_NORMAL)

#define CheckOverflow(tp,row)	(row <= tp->arows ? ERR_NORMAL :	\
				 TBL_ALLOROW(tid, row + row/5))

/*

*/

/*=======================================================================
 *		Internal Routines
 *=======================================================================*/

#ifdef __STDC__
static int chk_items( int dtype, int items)
#else
static int chk_items( dtype, items)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Compute the relevant number of items
..RETURNS Corrected number of items -- 0 of none !
-------------------------------------------------------------*/
	int	dtype;	/* IN: Table datatype	*/
	int	items;	/* IN : how many	*/
#endif
{
register int	emax;



emax  = TBL_Items(dtype);	/* How many exist in Column */
if (items > emax) items = emax;

esize = TBL_ElementSize(dtype);
bytes = esize * items;		/* Bytes to read */

return(items);
}


#ifdef __STDC__
static int check_items( int dtype, int start, int items)
#else
static int check_items( dtype, start, items)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Compute the relevant number of items
..RETURNS Corrected number of items -- 0 of none !
-------------------------------------------------------------*/
	int	dtype;	/* IN: Table datatype	*/
	int	start;	/* IN: Starting element	*/
	int	items;	/* IN : how many	*/
#endif
{
register int	emax;


if (items == 0) items = TBL_D_MASK;	/* Maximal element #	*/

esize = TBL_ElementSize(dtype);
emax  = TBL_Items(dtype);	/* How many exist in Column */

start --;
if (start < 0)	
   eoffs = 0;
else
   {
   emax -= start;		/* Maximum accessible	*/
   eoffs = esize * start;
   }

if (items > emax) items = emax;

if (items < 0)	
   {
   bytes = eoffs = 0;
   return 0;
   }

bytes = esize * items;		/* Bytes to read */
return(items);
}

/*

*/

#ifdef __STDC__
static int bin_read(int tid, int row, int col, int index, int items, 
		    char *value, int otype)
#else
static int bin_read(tid, row, col, index, items, value, otype)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Read table array element with binary-to-binary conversion
	(no character string involved)
..RETURNS status 
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	char	*value;	/* OUT: actual values   */
	int	otype;	/* IN: Datatype of value*/
#endif
{
	TABLE	*tp;
	int	dtype, ic;
	int	n, status;
	char	*x;

                       				/* checks arguments	*/
  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckRow(tp, row)))	return(TBL_errs(tid, status, row));

  dtype   = tp->dtypes[col-1];
  if_not((n = check_items(dtype, index, items)))	/* No item left... */
	return(status);

  ic      = TBL_offset (tp, row, col) + (eoffs);
  if_not((x = TBL_RD (tp, ic, bytes)))	return(TBL_RDst());

  otype = ((otype & (~TBL_D_MASK))| n);
  dtype = ((dtype & (~TBL_D_MASK))| n);

	/* When no conversion required, straight copy	*/
  if (dtype == otype)
	oscopy (value, x, bytes);
  else {		/* Conversion performed by TBL_cv2 (takes care
				of conversions of NULL values)		*/
	status = TBL_cv2(x, dtype, value, otype);
	if (status)
		TBL_errf(-1, "%d numeric overflows from table %s[@%d #%d]", 
		status, tp->phname, row, col);
	status = ERR_NORMAL;
  }

		/* Fill the rest (unread) with NULLs */
  if (items > n) {
  	bytes = n*TBL_ElementSize(otype); /* How many bytes were written */
	TBL_toNULL( (otype & (~TBL_D_MASK))|(items-n), value+bytes);
  }


  return(status);
}


#ifdef __STDC__
static int bin_write(int tid, int row, int col, int index, int items, 
                     char *value, int otype)
#else
static int bin_write(tid, row, col, index, items, value, otype)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Write table array element with binary-to-binary conversion
	(no character string involved)
..RETURNS status 
-------------------------------------------------------------*/
	int	tid;	/* MOD: table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	char	*value;	/* IN : actual values   */
	int	otype;	/* IN: Datatype of value*/
#endif
{
	TABLE	*tp;
	int	dtype, ic;
	int	n, status;
	char	*x;

                       				/* checks arguments	*/
  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckRow(tp, row)))	return(TBL_errs(tid, status, row));
  if ((row > tp->rows))         tp->selected = row, tp->rows = row;


  dtype = tp->dtypes[col-1];
  if_not(n = check_items(dtype, index, items))	/* No item left... */
	return(ERR_TBLFMT);

  ic = TBL_offset (tp, row, col) + eoffs;
  if_not((x= TBL_RDF (tp, ic, bytes, 1)))	return(TBL_RDst());

  otype = ((otype & (~TBL_D_MASK))| n);
  dtype = ((dtype & (~TBL_D_MASK))| n);
	/* When no conversion required, straight copy	*/
  if (dtype == otype)
	oscopy (x, value, bytes);
  else {		/* Conversion performed by TBL_cv2 (takes care
				of conversions of NULL values)		*/
	status = TBL_cv2(value, otype, x, dtype);
	if (status)
		TBL_errf(-1, "%d numeric overflows to table %s[@%d #%d]", 
		status, tp->phname, row, col);
	status = ERR_NORMAL;
  }

  return(status);
}
/*

*/

/*=======================================================================
 *		Public Routines
 *=======================================================================*/

int TCAMAP(tid, row, col, addr)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Return the address of the COMPLETE element array
..RETURNS status
------------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	char	**addr;	/* OUT: element adress	*/
{
	TABLE	*tp;
	int	ic, dtype;
	char	*x;
	int	n, status;

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckRow(tp, row)))	return(TBL_errs(tid, status, row));

  dtype   = tp->dtypes[col-1];
  ic      = TBL_offset (tp, row, col);
  n = check_items(dtype, 1, TBL_D_MASK);	/* Set the bytes static	*/

		/* The variable map_arg is normally TBL__MAPPED;
		   However, it's zero when called from TCARDC ! 	*/
if_not((x =  TBL_RDF (tp, ic, bytes, map_arg)))   return(TBL_RDst());
  *addr = x; 
					/* Update used rows 	*/
  if ((map_arg && (row > tp->rows)))	tp->rows = row, tp->selected = row;

  return (status);
}

int TCAUNM(tid, address)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Unmap a part of the file that was mapped.
..RETURNS status (-1 if not mapped)
-------------------------------------------------------------*/
	int	tid;		/* IN : table id	*/
	char	*address;	/* IN: column address   */
{
	TABLE	*tp;
	int	status;
	
  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));

  return (TBL_UMAP(tp, address));
}
/*================================================================
 *		Conversion Routines
 *================================================================*/

int TCAEDC(tid, abin, col, index, items, buffer)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Edit the element array "abin". The function is similar to
	 TCARDC, but has the value in memory instead of in table
	 (typically the result of TCAMAP).
..RETURNS status
..REMARKS No null flag here (null values have buffer[0] = 0).
	Output buffer assumed to be large enough (size is returned
	by TBFGET)
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	char	*abin;	/* IN : values to edit	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	char	*buffer;	/* OUT: edited value    */
{
	TABLE	*tp;
	int	n, status;
	int	dtype, dummy;
	char  	form[TBL_FORLEN+1];

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));

  dtype   = tp->dtypes[col-1];
  if_not((n = check_items(dtype, index, items)))	/* No item left... */
	return(status);

  if ((status = TCFGET(tid, col, form, &dummy, &dummy))) return(status);
  TBL_ed (buffer, form, ((dtype&(~TBL_D_MASK))|n), abin + eoffs);


  return (status);
}

int TCATRC(tid, abin, col, index, items, buffer)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Interpret (TRanslate) the character value in buffer.
	 This function is similar to TCAWRC, but converts the
	 value to memory (no table access)
..RETURNS status
..REMARKS No null flag here (null values have buffer[0] = 0).
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	char	*abin;	/* OUT: value to edit	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	char	*buffer;/* IN : edited value    */
{
	TABLE	*tp;
	int	n, status;
	int	dtype, dummy;
	char  	form[TBL_FORLEN+1];

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));

  dtype   = tp->dtypes[col-1];
  if_not((n = check_items(dtype, index, items)))	/* No item left... */
	return(status);

  if ((status = TCFGET(tid, col, form, &dummy, &dummy))) return(status);
  status = TBL_cv (buffer, form, (dtype&(~TBL_D_MASK))|n, abin + eoffs);
  
  return (status);
}

/*================================================================
 *		Reading Routines
 *================================================================*/

int TCARDC(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Reads table element as a character string.
         Arrays are edited with a comma between elements.
..RETURNS        status (error and non-selected)
..METHOD  Map first the element, then use TCAEDC to convert to char.
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	char	*value;	/* OUT: actual value    */
{
	char	*addr;
	int	status, old_map;

  old_map = map_arg;	map_arg = 0;	/* No Modification */
  status  = TCAMAP(tid, row, col, &addr);
  map_arg = old_map;
  if (status)		return(status);

		/* Use TCAEDC for Edition */
  return(TCAEDC(tid, addr, col, index, items, value));
}

int TCARDD(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Reads table element as a double precision variable.
..RETURNS status 
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	double	*value;	/* OUT: actual values   */
{
  return (bin_read(tid, row, col, index, items, (char *)value, TBL_D_R8<<TBL_D_BITS));
}

int TCARDI(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Reads table element as integer value.
..RETURNS status 
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	int	*value;	/* OUT: actual value    */
{
  return (bin_read(tid, row, col, index, items, (char *)value, TBL_D_I4<<TBL_D_BITS));
}

int TCARDR(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Reads table element as float.
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	float	*value;	/* OUT: actual value    */
{
  return (bin_read(tid, row, col, index, items, (char *)value, TBL_D_R4<<TBL_D_BITS));
}

int TCARDS(tid, row, col, index, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Reads table element as string.
..RETURNS status
-------------------------------------------------------------*/
        int     tid;    /* IN : table id        */
        int     row;    /* IN : row number      */
        int     col;    /* IN : column number   */
        int     index;  /* IN : index number    */
        char   *value; /* OUT: actual value    */
{
        TABLE  *tp;
	char	*addr,ws1[4];
	int	status, old_map;
        int    items, bytes, dtype;

  bytes = 0;
  old_map = map_arg;	map_arg = 1;	/* To Write */
  status  = TCAMAP(tid, row, col, &addr);
  map_arg = old_map;
  if (status)		return(status);
  tp = TBL_ptr(tid);            /* Might be changed by overflow */
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

  dtype = tp->dtypes[col-1];
  if ((dtype & (~TBL_D_MASK)) == 0) {
        GetLabel(tp,col,39,3,ws1);	/* ws1 needs 3 + 1 length! */
        items = atoi(ws1);
        if (items == 0) items = 1;
        bytes = TBL_Items(dtype);
        bytes = bytes/items;
        index = (index-1) * bytes +1;
        }
  return(TCAEDC(tid,addr,col,index,bytes,value));
}
int TCADEL(tid, row, col, index, items)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Deletes  table elements.
..METHOD	 Writes a NULL value in the table.
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
{
	TABLE	*tp;
  	int	dtype;
	char	*x;
	int	status, ic, n;

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckRow(tp, row)))	return(TBL_errs(tid, status, row));

  dtype   = tp->dtypes[col-1];
  if_not((n = check_items(dtype, index, items)))	/* No item left... */
	return(status);

  ic = TBL_offset (tp, row, col) + (eoffs);

				/* Write the NULL value		*/
  if_not((x = TBL_RDF (tp, ic, bytes, 1)))
  	return(TBL_RDst());
  TBL_toNULL ((dtype & (~TBL_D_MASK))|n, x);

					/* Update used rows 	*/
  if (row > tp->rows)	tp->rows = row;

  return (status);
}
/*

*/

void *TCTTST(tid)

int     tid;    /* IN : table id        */

{
int  status;

TABLE  *tp;

tp = TBL_ptr(tid);
if ((status = CheckTable(tp))) 
   return((void *) 0);
else
   return ((void *) tp);
}


int xTCAWRC(tp, tid, row, col, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, character string format. 
..RETURNS status
-------------------------------------------------------------*/
TABLE	*tp;	/* IN : table pointer	*/
int	tid;	/* IN : table id	*/
int	row;	/* IN : row number 	*/
int	col;	/* IN : column number	*/
int	items;	/* IN : how many	*/
char	*value;	/* IN : actual value    */
{
char	*addr, *f;

int	colm1, ic, no, dtype, j;




colm1 = col - 1;
dtype = tp->dtypes[colm1];

/* get offset within table */

if (tp->swise == F_RECORD )
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
else
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];


/* set static stuff and check, if no item left... */

if_not(no = chk_items(dtype,items)) return(ERR_TBLFMT);
if_not(addr = TBL_RDF(tp,ic,bytes,1))  return(TBL_RDst());


/* Update used rows     */

if (row > tp->rows) tp->selected = row, tp->rows = row;

/* Is already loaded ?  */

f = tp->format + (1+TBL_FORLEN)*colm1;
if (*f == '\0')			/* read format of that column */
   (void) SCDGETC(tp->imno,TBL_Dlab(col),33,9,&j,f);

return (TBL_cv(value,f,(dtype&(~TBL_D_MASK))|no,addr));
}


int TCAWRC(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, character string format. 
..RETURNS status
-------------------------------------------------------------*/
int	tid;	/* IN : table id	*/
int	row;	/* IN : row number 	*/
int	col;	/* IN : column number	*/
int	index;	/* IN : index number 	*/
int	items;	/* IN : how many	*/
char	*value;	/* IN : actual value    */
{
TABLE  *tp;
char	*addr;
char    form[TBL_FORLEN+1];

int	status, dummy;
int	ic, no, dtype;


tp = TBL_ptr(tid);
if ((status = CheckTable(tp))) 
   return(TBL_errs(tid, status,0));

if ((status = CheckTrueColumn(tp, col)))
   return(TBL_errs(tid, status, col));

if ((status = CheckRow(tp, row))) 
   return(TBL_errs(tid, status, row));

dtype = tp->dtypes[col-1];
ic = TBL_offset (tp, row, col);

 /* set static stuff and check, if no item left... */
if_not(no = check_items(dtype, index, items)) return(status);

if_not((addr = TBL_RDF (tp, ic, bytes, 1)))  return(TBL_RDst());

/* Update used rows     */
if (row > tp->rows)         tp->selected = row, tp->rows = row;

if ((status = TCFGET(tid, col, form, &dummy, &dummy))) return(status);
status = TBL_cv (value, form, (dtype&(~TBL_D_MASK))|no, addr + eoffs);

return (status);
}


int TCAWRD(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, double precision argument.
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	double	*value;	/* IN : actual value    */
{
  return(bin_write(tid, row, col, index, items, (char *)value, TBL_D_R8<<TBL_D_BITS));
}

int TCAWRI(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, integer variable as argument.
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	int	items;	/* IN : how many	*/
	int	*value;	/* IN : actual value    */
{
  return(bin_write(tid, row, col, index, items, (char *)value, TBL_D_I4<<TBL_D_BITS));
}


int TCAWRR(tid, row, col, index, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, float as input argument.
..RETURNS status
-------------------------------------------------------------*/
        int     tid;    /* IN : table id        */
        int     row;    /* IN : row number      */
        int     col;    /* IN : column number   */
        int     index;  /* IN : index number    */
        int     items;  /* IN : how many        */
        float   *value; /* IN : actual value    */
{
  return(bin_write(tid, row, col, index, items, (char *)value, TBL_D_R4<<TBL_D_BITS));
}



int xTCAWRD(tp,tid, row, col, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, double precision argument.
..RETURNS status
-------------------------------------------------------------*/
TABLE   *tp;    /* IN : table pointer   */
int     tid;    /* IN : table id        */
int     row;    /* IN : row number      */
int     col;    /* IN : column number   */
int     items;  /* IN : how many        */
double  *value; /* IN : actual value    */

{
int   ic, n, dtype, colm1;

char  *x;



if (row > tp->rows) tp->selected = row, tp->rows = row;

colm1 = col - 1;
dtype = tp->dtypes[colm1];
if_not(n = chk_items(dtype,items)) return(ERR_TBLFMT);

/* get offset within table */

if (tp->swise == F_RECORD )
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
else
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];

if_not(x =  TBL_RDF (tp, ic, bytes, 1))   return(TBL_RDst());
memcpy (x, (char *)value,(size_t) bytes);

return(0);
}


int xTCAWRI(tp,tid, row, col, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, integer variable as argument.
..RETURNS status
-------------------------------------------------------------*/
TABLE	*tp;	/* IN : table pointer	*/
int     tid;    /* IN : table id        */
int     row;    /* IN : row number      */
int     col;    /* IN : column number   */
int     items;  /* IN : how many        */
int     *value; /* IN : actual value    */

{
char  *x;

int   colm1, ic, n, dtype;



if (row > tp->rows) tp->selected = row, tp->rows = row;

colm1 = col - 1;
dtype = tp->dtypes[colm1];

if_not(n = chk_items(dtype,items)) return(ERR_TBLFMT);

/* get offset within table */

if (tp->swise == F_RECORD )
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
else
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];
 
if_not(x = TBL_RDF (tp, ic, bytes, 1)) return(TBL_RDst());
memcpy (x, (char *)value,(size_t) bytes);

return(0);
}

int xTCAWRR(tp, tid, row, col, items, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, float as input argument.
..RETURNS status
-------------------------------------------------------------*/
TABLE	*tp;	/* IN : table pointer	*/
int     tid;    /* IN : table id        */
int     row;    /* IN : row number      */
int     col;    /* IN : column number   */
int     items;  /* IN : how many        */
float   *value; /* IN : actual value    */

{
char  *x;

int   colm1, ic, n, dtype;




if (row > tp->rows) tp->selected = row, tp->rows = row;

colm1 = col - 1;
dtype = tp->dtypes[colm1];
if_not(n = chk_items(dtype,items)) return(ERR_TBLFMT);

/* get offset within table */

if (tp->swise == F_RECORD )
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
else
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];

if_not(x = TBL_RDF (tp, ic, bytes, 1)) return(TBL_RDst());
memcpy (x, (char *)value,(size_t) bytes);

return(0);
}


int TCAWRS(tid, row, col, index, value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE Writes table element, character string format. 
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id	*/
	int	row;	/* IN : row number 	*/
	int	col;	/* IN : column number	*/
	int	index;	/* IN : index number 	*/
	char	*value;	/* IN : actual value    */
{
        TABLE  *tp;
	char	*addr,ws1[4];
	int	status, old_map;
        int    items, bytes, dtype;

  bytes = 0;
  old_map = map_arg;	map_arg = 1;	/* To Write */
  status  = TCAMAP(tid, row, col, &addr);
  map_arg = old_map;
  if (status)		return(status);
  tp = TBL_ptr(tid);            /* Might be changed by overflow */
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

  dtype = tp->dtypes[col-1];
  if ((dtype & (~TBL_D_MASK)) == 0) {
        GetLabel(tp,col,39,3,ws1);	/* ws1 needs 3 + 1 length! */
        items = atoi(ws1);
        if (items == 0) items = 1;
        bytes = TBL_Items(dtype);
        bytes = bytes/items;
        index = (index-1) * bytes +1;
        }

		/* Use TCATRC for Edition */
  return(TCATRC(tid, addr, col, index, bytes, value));
}
/*================================================================
 *		Searching Routines
 *================================================================*/

int TCASRC(tid, row, col, index, items, value, next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE  Search the first row that matches a set of values provided in
		character form.
..PURPOSE Search element in character string format.
\begin{TeX}
	Search is performed on the table {\em tid},
	examining rows from {\em row} on.
	It compares {\em items} elements of the column {\em col}
	from {\em index} with the array {\em value}, 
	and stops when a match occurs.
	The result {\em next} is $-1$ if nothing appropriate was found.
\end{TeX}
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id		*/
	int	row;	/* IN : starting row number 	*/
	int	col;	/* IN : column number		*/
	int	index;	/* IN : index number 		*/
	int	items;	/* IN : how many items to compare*/
	char	*value;	/* IN : Comparison vector	*/
	int	*next;	/* OUT: found row number 	*/
{
	TABLE	*tp;
	int	n, status;
  	int	dtype;

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckTrueRow(tp, row)))	return(TBL_errs(tid, status, row));

  dtype   = tp->dtypes[col-1];
  *next = -1;
  if_not((n = check_items(dtype, index, items)))	/* No item left... */
	return(status);

  SCTPUT(" ++++ TCASRC Not Yet Implemented ++++");
  status = ERR_TBLIMP;

  return(status);
}

int TCASRD(tid, row, col, index, items, value, next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE  Search the first row that matches a set of values provided in
		double precision.
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id		*/
	int	row;	/* IN : starting row number 	*/
	int	col;	/* IN : column number		*/
	int	index;	/* IN : index number in col 	*/
	int	items;	/* IN : How many to compare	*/
	double	*value;	/* IN : Comparison vector	*/
	int	*next;	/* OUT: found row number 	*/
{
	TABLE	*tp;
	int	n, status;
  	int	dtype;

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckTrueRow(tp, row)))	return(TBL_errs(tid, status, row));

  dtype   = tp->dtypes[col-1];
  *next = -1;
  if_not(n = check_items(dtype, index, items))	/* No item left... */
	return(status);

  SCTPUT(" ++++ TCASRD Not Yet Implemented ++++");
  status = ERR_TBLIMP;

  return(status);
}

int TCASRI(tid, row, col, index, items, value, next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE  Search the first row that matches a set of values provided in
		integer.
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id		*/
	int	row;	/* IN : starting row number 	*/
	int	col;	/* IN : column number		*/
	int	index;	/* IN : index number in col 	*/
	int	items;	/* IN : How many to compare	*/
	int	*value;	/* IN : Comparison vector	*/
	int	*next;	/* OUT: found row number 	*/
{
	TABLE	*tp;
	int	n, status;
  	int	dtype;

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckTrueRow(tp, row)))	return(TBL_errs(tid, status, row));

  dtype   = tp->dtypes[col-1];
  *next = -1;
  if_not((n = check_items(dtype, index, items)))	/* No item left... */
	return(status);

  SCTPUT(" ++++ TCASRC Not Yet Implemented ++++");
  status = ERR_TBLIMP;

  return(status);
}

int TCASRR(tid, row, col, index, items, value, next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
..PURPOSE  Search the first row that matches a set of values provided in
		double precision.
..RETURNS status
-------------------------------------------------------------*/
	int	tid;	/* IN : table id		*/
	int	row;	/* IN : starting row number 	*/
	int	col;	/* IN : column number		*/
	int	index;	/* IN : index number in col 	*/
	int	items;	/* IN : How many to compare	*/
	float	*value;	/* IN : Comparison vector	*/
	int	*next;	/* OUT: found row number 	*/
{
	TABLE	*tp;
	int	n, status;
  	int	dtype;

  tp = TBL_ptr(tid);
  if ((status = CheckTable(tp)))	return(TBL_errs(tid, status,0));
  if ((status = CheckTrueColumn(tp, col)))
	  				return(TBL_errs(tid, status, col));
  if ((status = CheckTrueRow(tp, row)))	return(TBL_errs(tid, status, row));

  dtype   = tp->dtypes[col-1];
  *next = -1;
  if_not(n = check_items(dtype, index, items))	/* No item left... */
	return(status);

  SCTPUT(" ++++ TCASRC Not Yet Implemented ++++");
  status = ERR_TBLIMP;

  return(status);
}

