/* @(#)fitswbt.c	17.1.1.1 (ES0-DMD) 01/25/02 17:39:10 */
/*===========================================================================
  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
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.COPYRIGHT  (c)  1993  European Southern Observatory
.IDENT      fitswbt.c
.LAUGUAGE   C
.AUTHOR     P.Grosbol   ESO/IPG
.KEYWORDS   FITS Binary table data
.COMMENT    write FITS Binary table data
.VERSION    1.0  1989-Feb-24 : Creation,   PJG 
.VERSION    1.1  1989-Jul-05 : Include more data types,   PJG 
.VERSION    1.2  1990-Feb-04 : Change call-seq. for cv-routine, PJG 
.VERSION    2.0  1991-Mar-22 : Change structures, PJG 
.VERSION    2.1  1991-Apr-17 : Correct pointer error, PJG 
.VERSION    2.15 1991-Sep-24 : Insert check for NULL values, PJG 
.VERSION    2.2  1993-Oct-26 : Update for new TC and prototypes, PJG 
---------------------------------------------------------------------*/
#include   <computer.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <fitskwt.h>
#include   <midas_def.h>
#include   <tblsys.h>

int fitswbt(mfd)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       write FITS Binary table data
.RETURN        return status  0:OK, -1:error
---------------------------------------------------------------------*/
int           mfd;             /* IN: MIDAS file number              */
{
  unsigned char  *pu;
  char           *pb, *buf, *pc;
  short          *ps;
  int            ncol, nrow, nrw, mxcol;
  int            n, nr, nc, null, nb, ncw;
  int            *pi, inull;
  FDEF           *fd;
  TXDEF          *tdef, *fitstbl();
  union {
           unsigned char   *b;
           char            *c;
           short int       *s;
           int             *i;
           long            *l;
           float           *f;
           double          *d;
         } p;

  tdef = fitstbl(-1,' ',' ');
  ncol = tdef->tfields;
  nrow = tdef->nrow;
  nrw  = tdef->mxrow;
  mxcol = tdef->mxcol;
  TBL_toNULL((TBL_D_I4<<TBL_D_BITS)|1, (char *) &inull);

  buf = (char *) osmmget(nrw+8);
  if (!buf) {				/* get internal buffer */
     SCTPUT("Error: cannot allocate internal buffer");
     return -1;
  }
  p.c = (char *) osmmget(mxcol);
  if (!p.c) {				/* get column buffer   */
     SCTPUT("Error: cannot allocate column buffer");
     return -1;
  }

  for (nr=1; nr<=nrow; nr++) {               /* write row by row    */
      pb = buf; fd = tdef->col;
      for (nc=1; nc<=ncol; nc++, fd++) {     /* encode each column  */
          nb = fd->twdth;
	  ncw = fd->trepn;
          switch (fd->tdfmt) {
             case 'A' :                               /* string     */
                  TCARDC(mfd,nr,nc,1,ncw,pb);
                  pb += nb;
                  break;
             case 'L' :                               /* logical    */
                  TCARDC(mfd,nr,nc,1,ncw,pb);
                  pb += nb;
                  break;
             case 'E' :                               /* float      */
                  TCARDR(mfd,nr,nc,1,ncw,p.f);
                  cvr4(p.f,ncw,1);
		  pc = p.c;
                  while (nb--) *pb++ = *pc++;
                  break;
             case 'D' :                               /* double     */
                  TCARDD(mfd,nr,nc,1,ncw,p.d);
                  cvr8(p.d,ncw,1);
		  pc = p.c;
                  while (nb--) *pb++ = *pc++;
                  break;
             case 'I' :                               /* integer    */
                  TCARDI(mfd,nr,nc,1,ncw,p.i);
                  cvi4(p.i,ncw,1);
		  pc = p.c;
                  while (nb--) *pb++ = *pc++;
                  break;
             case 'S' :                               /* short int. */
                  TCARDI(mfd,nr,nc,1,ncw,p.i);
		  pi = p.i; ps = p.s;
		  n = ncw; null = fd->tnnul;
		  while (n--)
		    if (*pi == inull) *ps++ = null, pi++;
		     else *ps++ = *pi++;
                  cvi2(p.s,ncw,1);
		  pc = p.c;
                  while (nb--) *pb++ = *pc++;
                  break;
             case 'B' :                               /* byte int.  */
                  TCARDI(mfd,nr,nc,1,ncw,p.i);
		  pi = p.i; pu = p.b;
		  n = ncw; null = fd->tnnul;
		  while (n--) 
		    if (*pi == inull) *pu++ = null, pi++;
		     else *pu++ = *pi++;
		  pc = p.c;
                  while (nb--) *pb++ = *pc++;
                  break;
             case 'X' :                               /* hex flags  */
	          nb = ncw;
                  TCARDI(mfd,nr,nc,1,ncw,p.i);
		  pi = p.i; pu = p.b; n = ncw;
		  while (n--) *pu++ = *pi++;
		  pc = p.c;
                  while (nb--) *pb++ = *pc++;
                  break;
          }
      }
      dwrite(buf,nrw);
  }

  dbfill('\0');
  osmmfree(buf); osmmfree(p.c);
  return 0;
}