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

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.IDENT      fitswdb.c
.LAUGUAGE   C
.AUTHOR     P.Grosbol   ESO/IPG
.KEYWORDS   FITS header, MIDAS descriptor block
.COMMENT    write MIDAS descriptor to FITS header
.VERSION    1.0  1991-Mar-17 : Creation,   PJG
.VERSION    1.1  1992-Sep-10 : Add DCTL,ZCTL,TCTL flags,   PJG
.VERSION    1.2  1993-Jul-06 : Write comment from descriptor,   PJG
.VERSION    1.3  1993-Sep-03 : Correct error in descriptor help,   PJG
.VERSION    1.4  1993-Sep-16 : Check for empty descriptor help,   PJG
.VERSION    1.5  1993-Oct-26 : Update to new SC + prototypes,   PJG
.VERSION    1.6  1994-Jun-28 : Change fitswkd calls + R*4 desc,   PJG
.VERSION    1.7  1995-Sep-27 : Correct read of R4-desc with DCTL, PJG
.VERSION    1.8  1995-Oct-12 : Write simple desc. as prime keywords, PJG
.VERSION    1.9  1995-Nov-04 : Correct error in char. count, PJG
.VERSION    2.0  1996-Oct-22 : Update for new long descriptor names, PJG
.VERSION    2.1  1997-Jul-29 : Terminate string keywords with NULL, PJG

 110214		last modif
---------------------------------------------------------------------*/

#include   <string.h>
#include   <stdlib.h>
#include   <stdio.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <fitskwb.h>
#include   <fitsdkw.h>
#include   <fitshkw.h>
#include   <midas_def.h>

#define    MXLB           81           /* max. char. in line buffer  */
#define    MXFH           80 

typedef struct {                       /* Descriptor structure       */
                 char    name[MXMDN];  /* Name of descriptor         */
		 char           type;  /* Type of descriptor         */
		 int              ne;  /* No. of elements in desc.   */
		 int             nbp;  /* No. of bytes per element   */
		 char          class;  /* FITS keyword class         */
		 DTOKW          *dtk;  /* Descriptor->keyword map    */
	       } MDESC;

int fitswdb(mfd,ddflag,fits_info)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       write MIDAS descriptor to FITS header
.RETURN        return status  0:OK, -1:error
---------------------------------------------------------------------*/
int           mfd;		/* IN: MIDAS file number              */
int           ddflag;		/* IN: = 1, if DATAMIN,MAX already written */
int           *fits_info;	/* IN: flags for handling FITS header
	      f_head = fits_info[0]
				= 1, original mode for single, real keywords
				= 2, single, real keywords -> ESO-DESCRIPTORS 
	      cont_flag = fits_info[1]
				= 1, use CONTINUE keyword
				= 0, long char. descr -> ESO-DESCRIPTORS  */


{
char    cn, *pc, *pd, *ph, *pdx;
char    com[MXLB], cval[MXLB], line[MXLB], help[MXLB], *hkb[MXHKW];
char    dname[52], dtype[12], fhc[MXLB], bigbuf[1024];
char    *ymddate();

int     n, nc, nn, nv, nom, nof, noh, nod, nok;
int     ns, ne, nbp, ival, null, unit[4];
int     dbytelem, dnoelem, dhnc;
int     f_head, cont_flag, iav, ksize, ioff;

size_t  sz1, sz2;

float   fval, f[3];

double  dval, d[3];

DKMAP   *dk;
DTOKW   *dtk;
KWDEF   *kwd;
HKWL    *hkl;
MDESC   *mdesc, *md;





pdx = (char *) 0;
cn = ' ';

f_head = fits_info[0];
cont_flag = fits_info[1];


/* Get total no. of descriptors */

  (void) SCDRDX(mfd,2,dname,dtype,&dbytelem,&dnoelem,&dhnc);
  sz1 = (size_t)(dnoelem+1);
  sz2 = (size_t) (sizeof(MDESC));

  mdesc = (MDESC *) calloc(sz1,sz2);  /* get buffer      */
  if (!mdesc) return -1;             /* error if no buffer available */

  md = mdesc;
  (void) SCDRDX(mfd,10,dname,dtype,&dbytelem,&dnoelem,&dhnc);
  (void) strcpy(md->name,dname);
  nom = noh = nof = nod = nok = 0;

  while (md->name[0] != ' ') {  /* go through all desc.   */
    md->type = dtype[0];
    md->ne = dnoelem;
    md->nbp = dbytelem;

    dk = dkm;
    while (dk->desc && strcmp(md->name,dk->desc)) dk++;
    if (dk->desc) {                /* use descriptor-to-keyword map */
       md->dtk = dk->dtk;
       if (md->dtk) { md->class = 'M'; nom++; }
       else md->class = '\0';
     }
    else if ((md->name[0] == '_' ||       /* HIERARCH keyword format */
	      strchr(md->name,'.')) &&
	     (md->ne==1 || (md->type=='C' && md->ne<68 && md->nbp==1))) {
       md->class = 'H';
       noh++;
     }
    else if ( (strlen(md->name)<9) && 
	      ( (md->ne == 1) || 
                ((md->type=='C') && (md->ne<69) && (md->nbp==1)) ) )
       {
       if ((md->type == 'R') && (f_head == 2))
          {
          md->class = 'D';		/* avoid automatic real -> double */
          nod++;
          }
       else
          {
          md->class = 'F';		/* prime FITS keyword */
          nof++;
          }
     }
    else if ( (cont_flag == 1) && (strlen(md->name)<9) && 
              (md->type=='C') && (md->ne>68) && (md->nbp==1) )
       {
       md->class = 'K';
       nok++;
       }
    else {                 /* else write in MIDAS descriptor format */
       md->class = 'D';
       nod++;
     }
    md++;

   get_next_descr:
    (void) SCDRDX(mfd,10,md->name,dtype,&dbytelem,&dnoelem,&dhnc);
    if (strncmp(md->name,"DATAM",5) == 0)
       {
       if ( (ddflag == 1) &&			/* DATAMIN already written */
            ( (strcmp(md->name,"DATAMAX") == 0) ||
              (strcmp(md->name,"DATAMIN") == 0) ) ) goto get_next_descr;
       }
  }

  md = mdesc; nv = 0; hkb[0] = "";
  if (nom) while (md->name[0]) {     /* go through all descriptors   */
    if (md->class=='M') {            /* write mapped descriptor     */
       dtk = md->dtk; ne = md->ne; nbp = md->nbp;
       if (md->type=='C' && nbp==1) { nbp = ne; ne = 1; }
       while (dtk->no) {
	  if (dtk->no<0) { ns = 1; n = ne; }
	  else { ns = dtk->no; n = (ne<ns) ? 0 : 1; }
	  while (n--) {
	     switch (md->type) {
		case 'L' :
		  SCDRDL(mfd,md->name,ns,1,&nv,&ival,unit,&null);
		  if (dtk->ctl==ZCTL && ival==0) break;
		  sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns);
		  fitswkl(dtk->kw,hkb,0,-1,ival,com);
		  break;
		case 'I' :
		  SCDRDI(mfd,md->name,ns,1,&nv,&ival,unit,&null);
		  if (dtk->ctl==ZCTL && ival==0) break;
		  sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns);
		  fitswki(dtk->kw,hkb,0,-1,ival,com);
		  break;
		case 'R' :
		  SCDRDR(mfd,md->name,ns,1,&nv,&fval,unit,&null);
		  sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns);
		  if (dtk->ctl==ZCTL && fval==0.0) break;
		  dval = fval;
		  if (dtk->ctl==TCTL) dval *= 3600.0;
		  if (dtk->ctl!=DCTL) 
		    fitswkd(dtk->kw,hkb,0,-1,dval,"%20.7G",com);
		  else {
		     SCDRDR(mfd,md->name,ns,3,&nv,f,unit,&null);
		     d[0] = f[0]; d[1] = f[1]; d[2] = f[2];
		     fitswks(dtk->kw,hkb,0,-1,ymddate(d[0],d[1],d[2]),com);
		   }
		  break;
                case 'D' :
		  SCDRDD(mfd,md->name,ns,1,&nv,&dval,unit,&null);
		  sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns);
		  if (dtk->ctl==ZCTL && dval==0.0) break;
		  if (dtk->ctl==TCTL) dval *= 3600.0;
		  if (dtk->ctl!=DCTL) 
		    fitswkd(dtk->kw,hkb,0,-1,dval,"%20.13G",com);
		  else {
		     SCDRDD(mfd,md->name,ns,3,&nv,d,unit,&null);
		     fitswks(dtk->kw,hkb,0,-1,ymddate(d[0],d[1],d[2]),com);
		   }
		  break;
                case 'C' :
		  if (dtk->ctl==NCTL || dtk->ctl==SCTL) {
		     nc = (MXLB<nbp) ? MXLB : nbp;
		     SCDRDC(mfd,md->name,1,ns,nc,&nv,cval,unit,&null);
		     cval[nv-1] = '\0';
		     for (nn=0; nn<nv-1; nn++)
		       if (cval[nn]<' ' || '~'<cval[nn])
			 cval[nn] = ' ';
		     if(dtk->ctl==SCTL) {
			ival = nv-2;
			while (ival && cval[ival]==' ') ival--;
			cval[++ival] = '\0';
		      }
		     n = 0;
		     sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns);
		     fitswks(dtk->kw,hkb,0,-1,cval,com);
		   }
		  else if (dtk->ctl==CCTL) {
		     n = 0; ns = 1;
		     while (ns<=nbp) {
                        nn = (nbp-ns<71) ? nbp-ns+1 : 72;
                        SCDRDC(mfd,md->name,1,ns,nn,&nv,cval,unit,&null);
                        for (nn=0; nn<nv; nn++) {
			   ns++;
			   if (cval[nn]=='\n') break;
			   if (cval[nn]<' ' || '~'<cval[nn])
			     cval[nn] = ' ';
			 }
                        if (72<=nn) {
			   nn--; ns--;
			   cval[nn++] = '\\';
			 }
                        cval[nn] = '\0';
                        fitswkc(dtk->kw,cval);
                      }
		   }
		}
	     ns++;
	   }
	  dtk++;
	}
     }
    md++;
  }


  md = mdesc; nv = 0; hkb[0] = "";
  if (nof || nok) while (md->name[0]) 
    {			      /* go through all descriptors   */
    if (md->class=='F') 
       {             /* write simple descriptor     */
       dtk = md->dtk; ne = md->ne; nbp = md->nbp;
       if (md->type=='C' && nbp==1) { nbp = ne; ne = 1; }
       switch (md->type) 
          {
	  case 'L' : 
            SCDHRL(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null);
	    fitswkl(md->name,hkb,0,-1,ival,help);
	    break;
	  case 'I' : 
            SCDHRI(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null);
	    fitswki(md->name,hkb,0,-1,ival,help);
	    break;
	  case 'R' : 
            SCDHRR(mfd,md->name,1,1,&nv,&fval,help,MXLB,unit,&null);
	    dval = fval;
	    fitswkd(md->name,hkb,0,-1,dval,"%9.6G",help);
	    break;
	  case 'D' : 
            SCDHRD(mfd,md->name,1,1,&nv,&dval,help,MXLB,unit,&null);
	    fitswkd(md->name,hkb,0,-1,dval,"%15.12G",help);
	    break;
	  case 'C' : nc = (MXLB<nbp) ? MXLB : nbp;
            SCDHRC(mfd,md->name,1,1,nc,&nv,cval,help,MXLB,unit,&null);
	    cval[nv--] = '\0';
            while (0<=nv && cval[nv]==' ') cval[nv--] = '\0';
	    fitswks(md->name,hkb,0,-1,cval,help);
	    break;
	    }
       }
    else if (md->class=='K')              /* write long char. descriptor   */
       {
       SCDRDC(mfd,md->name,1,1,md->ne,&iav,bigbuf,unit,&null);
       bigbuf[md->ne] = '\0';

       strcpy(fhc,"          ");
       strncpy(fhc,md->name,(int)strlen(md->name));
       fhc[8] = '=';
       fhc[9] = ' ';
       fhc[10] = '\'';
       strncpy(&fhc[11],bigbuf,67);
       ioff = 67;
       fhc[78] = '&';
       fhc[79] = '\'';
       fhc[80] = '\0';
       dwrite(fhc,MXFH);

       ksize = md->ne - ioff;
       while (ksize > 0)
          {
          memset((void*)fhc,32,(size_t)MXLB);	/* fill with blanks */

          strcpy(fhc,"CONTINUE  ");
          fhc[10] = '\'';
          if (ksize > 68)
             iav = 67;                         /* we need & in the end */
          else
             iav = ksize;		/* this will be the last record */

          strncpy(&fhc[11],bigbuf+ioff,iav);
          ioff += iav;
          ksize = md->ne - ioff;
       
          n = 11 + iav;                        /* point to end string in fhc */
          if (ksize > 0) fhc[n++] = '&';       /* more records needed */
          fhc[n] = '\'';

          fhc[80] = '\0';
          /*  printf("we write:\n%s\n",fhc); */
          dwrite(fhc,MXFH);
          }
       }
    md++;
    }

  md = mdesc; nv = 0; hkb[0] = "";
  if (noh) while (md->name[0]) {        /* go through all descriptors   */
    if (md->class=='H') {               /* write hierarchical keywords */
       dtk = md->dtk; ne = md->ne; nbp = md->nbp;
       if (md->type=='C' && nbp==1) { nbp = ne; ne = 1; }
       nn = 0;
       pc = com; pd = md->name;
       hkl = hkwgrp;
       if (md->name[0]=='_') {
	 do {
	   while (*(ph=hkl->abrv)) {
	     pdx = pd;
	     while (*ph == *pdx) ph++, pdx++;
	     if (!(cn = *ph) || cn=='#') break;
	     hkl++;
	   }
	   if (!(ph=hkl->name)) break;
	   pd = pdx;
	   hkb[nn++] = pc;
	   while ((*pc = *ph) != cn) pc++, ph++;
	   if (cn) while ('0'<=*pd && *pd<='9') *pc++ = *pd++;
	   *pc++ = '\0';
	   kwd = (KWDEF *) hkl->kw;
	   hkl = (HKWL *) hkl->next;
	 } while (*pd!='_' && hkl);
	 if (*pd++ == '_') {
	   hkb[nn++] = pc;
	   while ((*pc++ = *pd++));
	 }
	 else nn = 0;
       }
       else {
	 line[0] = '\0';
	 strcat(line,md->name);         /* get copy of descriptor name  */
	 nn = 0;
	 hkb[nn++] = strtok(line,".");  /* split it into levels         */
	 while ((hkb[nn] = strtok(NULL,"."))) nn++;
       }

       if (1<nn) {
	  switch (md->type) {
	     case 'L' : 
                SCDHRL(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null);
	                fitswkl("HIERARCH",hkb,nn,-1,ival,help);
                        break;
	     case 'I' : 
                SCDHRI(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null);
	                fitswki("HIERARCH",hkb,nn,-1,ival,help);
                        break;
             case 'R' : 
                SCDHRR(mfd,md->name,1,1,&nv,&fval,help,MXLB,unit,&null);
                        dval = fval;
                        fitswkd("HIERARCH",hkb,nn,-1,dval,"%9.6G",help);
                        break;
             case 'D' : 
                SCDHRD(mfd,md->name,1,1,&nv,&dval,help,MXLB,unit,&null);
                        fitswkd("HIERARCH",hkb,nn,-1,dval,"%15.12G",help);
                        break;
             case 'C' : nc = (MXLB<nbp) ? MXLB : nbp;
                SCDHRC(mfd,md->name,1,1,nc,&nv,cval,help,MXLB,unit,&null);
	                cval[nv--] = '\0';
                        while (0<=nv && cval[nv]==' ') cval[nv--] = '\0';
                        fitswks("HIERARCH",hkb,nn,-1,cval,help);
                        break;
	    }
	}
      }
    md++;
  }

  if (nod) {
     fitswkc("","");
     fitswkc("HISTORY"," ESO-DESCRIPTORS START   ................");
     md = mdesc; nv = 0; hkb[0] = "";
     while (md->name[0]) {              /* go though all descriptors    */
	if (md->class=='D')             /* write other midas descriptor */
	  fitswmd(mfd,md->name);
	md++;
      }
     fitswkc("HISTORY"," ESO-DESCRIPTORS END     ................");
     fitswkc("","");
   }

  free((char *) mdesc);
  return 0;
}
