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

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.LANGUAGE   C
.IDENTIFICATION      fitswmd.c
.AUTHOR     P.Grosbol   ESO/IPG
.KEYWORDS   MIDAS descriptor, FITS header, keywords
.COMMENT    write MIDAS descriptor in FITS header
.VERSION    1.0  1988-Dec-04 : Creation,   PJG 
.VERSION    1.1  1989-May-26 : Change format - for old-MIDAS,   PJG 
.VERSION    1.2  1989-Jun-12 : Change definition of unit+kunit, PJG 
.VERSION    1.3  1990-Feb-26 : Change format of char. desc., PJG 
.VERSION    1.4  1991-Jan-25 : Change include file, PJG 
.VERSION    1.5  1993-Oct-26 : Update to new SC + prototypes, PJG 
.VERSION    1.6  1998-Aug-19 : Change format, PJG 
.VERSION    1.7  2002-Jan-11 : Add logical type, PJG 

 060109		last modif
---------------------------------------------------------------------*/

#include   <stdio.h>
#include   <string.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <midas_def.h>

#define    MXFHC              80   /* characters in FITS header card */
#define    MXFCC              70   /* max. char. in FITS comment     */
/*

*/

int fitswmd(mfd,name)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       write MIDAS descriptor to FITS header
.RETURN        return status  0:OK, -1:error
---------------------------------------------------------------------*/
int           mfd;             /* IN: MIDAS file number              */
char        *name;             /* IN: name of MIDAS descriptor       */
{
char      *pc, c, type;
char      fhc[MXFHC+1], buf[MXFCC+1], chc[MXFHC+1];

int       ne, nbpe, n, nv, nf, no, epl, null, net;
int       i, idx, ival[7], unit[2];
int   SCTMES(), SCDRDL();

float     fval[5];

double    dval[3];





if (MXMDN <= (int)strlen(name)) 
   {
   (void)sprintf(fhc,"Error: descriptor >%s< skipped - name too long",
	         name);
    SCTMES(M_RED_COLOR,fhc);
    return (-1);
   }

if (SCDFND(mfd,name,&type,&ne,&nbpe)) return (-1);

nf = 1;				/* first element */

/* instead of:  fitswkc("HISTORY",fhc);
   we use: dwrite("HISTORY "//fhc,MXFHC);  directly */

switch (type) 
   {
  case 'L' :
   n = sprintf(fhc,"HISTORY  '%s','L*%d',1,%d,'35I2'",name,nbpe,ne);
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
   dwrite(fhc,MXFHC);	

   epl = 35;
   while (ne) 
      {                  /* go through all elements   */
      no = (epl<ne) ? epl : ne;
      SCDRDL(mfd,name,nf,no,&nv,ival,unit,&null);
      nf += nv; ne -= nv; n = 0; 
      idx = 9; pc = &fhc[idx];		/* position after 'HISTORY  ' */
      while (nv--)
         {             /* write one HISTORY card    */
         i = sprintf(pc,"%2d",ival[n]);
         pc += i; idx += i;
         n++;
         }
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
      dwrite(fhc,MXFHC);	
      }
   break;

  case 'I' :
   if (strcmp(name,"SELIDX") == 0)	/* Selection Index table */
      {			
      char      seltab[66];

      ival[0] = -99;
      SCDRDI(mfd,"SELIDX",1,1,&nv,ival,unit,&null);
      ne = ival[0] + 1;			/* get actually used size */ 
      if (ne < 2) return 0;		/* nothing to do... */

      (void) SCDGETC(mfd,"TSELTABL",1,64,&nv,seltab);
      if (nv > 0)
         {
         n = sprintf(fhc,"HISTORY  'XTSELTABL','C*1',1,%d,'70A1'",nv);
         while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
         dwrite(fhc,MXFHC);	
         n = sprintf(fhc,"HISTORY  %s",seltab);
         while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
         dwrite(fhc,MXFHC);	
         }
      }

   n = sprintf(fhc,"HISTORY  '%s','I*%d',1,%d,'7I10'",name,nbpe,ne);
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
   dwrite(fhc,MXFHC);	

   epl = 7;
   while (ne)
      {				/* go through all elements   */
      no = (epl<ne) ? epl : ne;
      SCDRDI(mfd,name,nf,no,&nv,ival,unit,&null);
      nf += nv; ne -= nv; n = 0; 
      idx = 9; pc = &fhc[idx];		/* position after 'HISTORY  ' */
      while (nv--) 
         {				/* write one HISTORY card    */
         i = sprintf(pc,"%10d",ival[n]);
         pc += i; idx += i;
         n++;
         }
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
      dwrite(fhc,MXFHC);	
      }
   break;

  case 'R' :
   n = sprintf(fhc,"HISTORY  '%s','R*%d',1,%d,'5E14.7'",name,nbpe,ne);
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
   dwrite(fhc,MXFHC);	

   epl = 5;
   while (ne) 
      {				/* go through all elements   */
      no = (epl<ne) ? epl : ne;
      SCDRDR(mfd,name,nf,no,&nv,fval,unit,&null);
      nf += nv; ne -= nv; n = 0; 
      idx = 9; pc = &fhc[idx];		/* position after 'HISTORY  ' */
      while (nv--) 
         {             /* write one HISTORY card    */
         i = sprintf(pc,"%14.7E",fval[n]); 
         pc += i; idx += i;
         n++;
         }
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
      dwrite(fhc,MXFHC);	
      }
   break;

  case 'D' :
   n = sprintf(fhc,"HISTORY  '%s','R*%d',1,%d,'3E23.15'",name,nbpe,ne);
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
   dwrite(fhc,MXFHC);	

   epl = 3;
   while (ne) 
      {				/* go through all elements   */
      no = (epl<ne) ? epl : ne;
      SCDRDD(mfd,name,nf,no,&nv,dval,unit,&null);
      nf += nv; ne -= nv; n = 0; 
      idx = 9; pc = &fhc[idx];		/* position after 'HISTORY  ' */
      while (nv--) 
         {             /* write one HISTORY card    */
         i = sprintf(pc,"%23.15E",dval[n]);
         pc += i; idx += i;
         n++;
         }
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
      dwrite(fhc,MXFHC);	
      }
   break;

  case 'C' :
   if (strcmp(name,"XTSELTABL") == 0)	/* don't write it again... */
      return 0;

   if (MXFCC<=nbpe)
      {
      sprintf(chc,"Warning: descriptor >%s< skipped - too long C*%d",
                  name,nbpe);
      SCTPUT(chc);
      break;
      }

   epl = (MXFCC < ne*nbpe) ? MXFCC : ne*nbpe;
   n = sprintf(fhc,"HISTORY  '%s','C*%d',1,%d,'%dA1'",name,nbpe,ne,epl);
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
   dwrite(fhc,MXFHC);	

   for (n=0; n<MXFHC; n++) chc[n] = ' '; chc[n] = '\0';

   n = 1; net = ne*nbpe;
   while (net)
      {                 /* go through all elements   */
      if (nbpe==1) no = (epl<net) ? epl : net; else no = 1;
      pc = buf;
      SCDRDC(mfd,name,nbpe,nf,no,&nv,pc,unit,&null);
      if (nv<=0) break;
      nf += nv; nv *= nbpe; net -= nv;
      while (nv--) 
         {
         c = *pc++;
         if (c=='\\' || c=='\n')
            {
            chc[n++] = '\\';
            if (MXFCC<n) 
               {
               chc[n] = '\0'; fitswkc("HISTORY",chc); n = 1;
	       }
            if (c=='\\') chc[n++] = '\\';
            else if (c=='\n') chc[n++] = 'n';
	    }
         else if (' '<=c && c<='~') 
            chc[n++] = c;
         else 
            chc[n++] = ' ';
         if (MXFCC<n) 
            {
            chc[n] = '\0'; fitswkc("HISTORY",chc); n = 1;
            }
	 }
      }
   if (1<n) 
      { 
      chc[n] = '\0'; fitswkc("HISTORY",chc);
      }
   break;
   }


for (n=9; n<MXFHC; n++) fhc[n] = ' '; fhc[n] = '\0';
dwrite(fhc,MXFHC);	

return 0;
}
