/*===========================================================================
  Copyright (C) 1995,2003 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
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.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 

 030801         last modif
---------------------------------------------------------------------*/

#include   <computer.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <fitsextvals.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);
         if (!same_comp_i4)
         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++;
         if (!same_comp_i2)
         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;
}
