/**************************************************************************
*                                                                        *
* Copyright (c) 1996 Michael Richmond and Richard Treffers               *
*                                                                        *
*                    This software may be copied and distributed for     *
*                    educational, research and not for profit services   *
*                    provided that this copyright and statement are      *
*                    included in all such copies.                        *
*                                                                        *
**************************************************************************/


/***************************************************************************
	fits

	Package of utility procedures for reading and writing FITS-format
	files.

	11/24/92- modified so that the routine will try to open
				fname , and if that does not exist, it will
				try 'fname.fts' . -rrt
			This is a very unpleasant business for the special cas
e
			of "w" in which a create option is asked.  In this
			case we try to do the following:
				infile        outfile
				foo           foo.fts
				foo.fts       foo.fts
				foo.xyz       foo.xyz
				../foo        ../foo.fts
			Also a test whether a file is actually writable is
			made.

***************************************************************************/

	/* this version has the fits_put_data_fast() bug fixed.  MWR 11/10/1991 */
	/* also has the fits_put_symbol() bug fixed.  MWR  11/12/1991 */
	/* also has the >36-line header bug fixed.  MWR 1/22/1992 */
	/* fixed a minor bug in "compar()".  MWR 12/13/92 */
	/* added support for BSCALE and BZERO.  MWR 12/16/92 */
	/* BSCALE and Bzero support modifie RRT 12/17/92 by putting
	scale_flag and bombing if incorrect value is found */
	/* added "get_next_handle()" and "is_used[]" to deal with closing
	FITS file correctly.  MWR 2/28/93 */
	/* fixed scaling over/under-flow bugs  MWR 5/30/93 */
	/* fits_get_symbol can now get longer symbols 7/5/93 -rrt */
	/* added 'fits_copyheader()' function to this file, improving
	      it to take care of BSCALE and BZERO.  Also added the
	      fits_resetscale() function. MWR 8/1/93. 
		modify so that scale_data[] is only set if
		BSCALE and BZERO are substantially different from 1 and 0 -rrt
		8/5/93
		  */

/*	1/28/94 somewhat modified for bitpix = 8 -rrt
	7/7/94 - prototypes for stdlib unistd added -rrt	
*/

#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include <stdlib.h>
#include <unistd.h>
#include <math.h>
#include <sys/types.h>                  /* needed for the stat call */
#include <sys/stat.h>
#include "pcvista.h"
#include "fits.h"

#undef DEBUG2

/*
 * apparently, this is needed under SunOs 5.5
 */
#ifdef SUN
extern int fileno(FILE *stream);
#endif

#define HEADER_LENGTH 2880      /* Standard header size for PC operations */
#define CARD_LEN 80             /* Size of header card image entry */
#define NAME_LEN 80             /* Size of header card image entry */
#define SYMBOL_LEN      8                       /* Length of FITS symbol
	*/
#define OBJECT_LEN  22                  /* Length of FITS symbol value  */

static char f_name[NHANDLE][NAME_LEN];  /* the names of the FITS files */
static FILE *ff[NHANDLE];       /* File handles for FITS files */
static short int ncol[NHANDLE];       /* Number of columns in data array */
static short int nrow[NHANDLE];       /* Number of rows in data array */

	/* true data value = (data + bzeroe)*bscale  */
static int scale_flag[NHANDLE]; /* flag whether to scale */
static double bzeroe[NHANDLE];         /* zero point of data */
static double bscale[NHANDLE];         /* scale factor for data */

static long header_length[NHANDLE];
				/* Actual header size for file */
static char *header[NHANDLE];   /* In-core version of header */
static int fast_done[NHANDLE];  /* indicates whether lseek necessary in the */
				/*    fits_put_data_fast() routine */
static int is_used[NHANDLE];    /* if is_used[i]==1, file i is now open */
static int handle = 0;          /* Number of file handle last opened */
static int bitpix[NHANDLE] ;         /* Number of bits/pixel */
static int put_symbol_flag[NHANDLE];/* flags if header has been modified */


/************************
Private Procedures
************************/

#ifdef PROTO
static char *get_line(FITS_HANDLE, int);
static void fits_seek(int, int, int);
static int compar(char *, char *);
static void inject(char *, char *, int);
static void enlarge_header(FITS_HANDLE);
static FILE *file_open(char * name, char * mode);
static void exten_with_care(char * name);
static int get_next_handle(void);
static int fequal(double,double);
#else
static char *get_line();
static void fits_seek();
static int compar();
static void inject();
static void enlarge_header();
static FILE *file_open();
static void exten_with_care();
static int get_next_handle();
static int fequal();
#endif

/******************************************************************************
	open_fits

	Open FITS file for processing.  3 i/o modes supported:
		"r"  -- Read only
		"w"  -- Write only
		"r+" -- Read and update
		"x"  -- Read update and and change the number of rows and cols
	For the "r" and "r+" cases, a header is read from the file into
	an internal header buffer; for the "w" case a dummy header is
	written, and then re-written at close time (to update any user
	changes to the header).
******************************************************************************/

FITS_HANDLE
fits_open(fname, mode, nrows, ncols)
char *fname;    /* Name of FITS file */
char *mode;     /* i/o mode */
int *nrows;/* Number of rows of pixels */
int *ncols;/* Size of a row, in pixels */
{
	char str[128], val[40], *p;
	char lname[128];
	int new_hdr_length;
	static int i, first = 0;

	if (first == 0) {
		first = 1;
		for (i = 0; i < NHANDLE; i++){
			header_length[i] = 2880;
			bzeroe[i]=0.;
			bscale[i]=1.0;
			scale_flag[i]=0;
			is_used[i] = 0;
			bitpix[i]=16;
		}
	}

	if ((handle = get_next_handle()) == -1)
		error(-1, "too many FITS files open");

		strncpy(lname, fname, 80);
	if (strcmp( mode, "r") == 0) {
	if ((ff[handle] = file_open(lname, "rb")) == NULL) {
		sprintf(str, "fits_open -- Can't open file %s", lname);
		error(-1, str);
	}
	}
	else if ((strcmp(mode, "r+") == 0) || (strcmp(mode,"x") == 0)) {
	if ((ff[handle] = file_open(lname, "r+")) == NULL) {
			sprintf(str, "fits_open -- Can't update file %s", lname)
;
		error(-1, str);
	}
	}
	else if (strcmp(mode, "w") == 0) {
	if ((ff[handle] = file_open(lname, "w")) == NULL) {
		sprintf(str, "fits_open -- Can't write file %s", lname);
		error(-1, str);
	}
	}
	else {
	sprintf(str, "fits_open -- Illegal i/o mode: %s for file %s",
		mode, lname );
	error(-1, str);
	}

		strcpy(f_name[handle], lname);

	header[handle] = (char *)malloc(HEADER_LENGTH);
	if (header[handle] == NULL) {
	sprintf(str, "fits_open -- Can't allocate header for %s", lname);
	error(-1, str);
	}

	if ((strcmp(mode, "r")  == 0) ||
		(strcmp(mode, "r+") == 0) ||
		(strcmp(mode, "x")  == 0)) {
	if (fread(header[handle], 1, HEADER_LENGTH, ff[handle])
							!= HEADER_LENGTH) {
		sprintf(str, "fits_open -- Bad read of file header for %s",
			lname );
		error(-1, str);
	}

	fits_get_symbol(handle, "SIMPLE", val);
	if (!compar(val, "T")) {
		sprintf(str, "fits_open -- File %s not of type SIMPLE=T",
			lname );
		error(-1, str);
	}

	fits_get_symbol(handle, "BITPIX", val);
	bitpix[handle]=atoi(val);
	if( (bitpix[handle] != 16) && (bitpix[handle] !=8) ){
		sprintf(str, "fits_open -- BITPIX = %d not supported, file %s",
			bitpix[handle], lname);
		error(-1, str);
	}

	fits_get_symbol(handle, "NAXIS", val);
	if (atoi(val) != 2) {
		sprintf(str, "fits_open -- NAXIS = %s not supported, file %s",
			val, lname);
		error(-1, str);
	}

			/* read in the BZERO value; if present */
			if (fits_get_symbol(handle, "BZERO", val) != FITS_FAIL)
{
				if (sscanf(val, "%lf", &(bzeroe[handle])) != 1)
					error(1,"illegal value for bzeroe");
				if(fequal(bzeroe[handle],0.) == 0)
					scale_flag[handle]=1;
			}

			/* read in the BSCALE value; if present */
			if (fits_get_symbol(handle, "BSCALE", val) != FITS_FAIL)
{
				if (sscanf(val, "%lf", &(bscale[handle])) != 1)
					error(1,"illegal value for bscale");
				if(fequal(bscale[handle],1.0) == 0)
					scale_flag[handle]=1;
			}

			if (strcmp(mode, "x") == 0) {
		sprintf(str, "%20d", *ncols);
		fits_put_symbol(handle, "NAXIS1", str);
		sprintf(str, "%20d", *nrows);
		fits_put_symbol(handle, "NAXIS2", str);
			}
	fits_get_symbol(handle, "NAXIS1", val);
	*ncols = atoi(val);
	fits_get_symbol(handle, "NAXIS2", val);
	*nrows = atoi(val);

			/* keep reading in blocks of header until one contains an
			"END" card. */
			while (fits_get_symbol(handle, "END", val) == FITS_FAIL) {
				new_hdr_length = header_length[handle] + HEADER_LENGTH;
				if ((p = (char *)malloc(new_hdr_length)) == NULL) {
					sprintf(str, "fits_open -- can't malloc for header");
					error(-1, str);
				}
				strncpy(p, header[handle], header_length[handle]);
				memset(p + header_length[handle], ' ', HEADER_LENGTH);
				free(header[handle]);
				header[handle] = p;
				fseek(ff[handle], (long) header_length[handle], 0);
				if (fread(header[handle] + header_length[handle],
						1, HEADER_LENGTH, ff[handle]) != HEADER_LENGTH) {
					sprintf(str, "fits_open -- bad read in file header of %s",
							lname);
					error(-1, str);
				}
				header_length[handle] = new_hdr_length;
			}
	}
	else {                                /* mode = "w" */
	memset(header[handle], ' ', HEADER_LENGTH); /* fill with blanks */

			inject(header[handle], "END", 3);
	fits_put_symbol(handle, "SIMPLE", "                   T");
	sprintf(str, "%20d", bitpix[handle]);
	fits_put_symbol(handle, "BITPIX", str);
	fits_put_symbol(handle, "NAXIS",  "                   2");
	sprintf(str, "%20d", *ncols);
	fits_put_symbol(handle, "NAXIS1", str);
	sprintf(str, "%20d", *nrows);
	fits_put_symbol(handle, "NAXIS2", str);
	}
	ncol[handle] = *ncols;
	nrow[handle] = *nrows;
	fast_done[handle] = 0;
	is_used[handle] = 1;
	return(handle);
}

/******************************************************************************
	fits_get_data

	Read signed integer data from FITS file, starting with (row, col),
	and proceeding for npix pixels.

	12/16/92 use BZERO and BSCALE values, if they are supplied  MWR
	1/28/94 add bitpix==8 rrt
******************************************************************************/

int
fits_get_data(h, row, col, data, npix)
FITS_HANDLE h;
int row;
int col;
int16 *data;
int npix;
{
	int i;
	unsigned char *p;
	double x;

#ifdef DEBUG2
printf("fits_get_data: seeking to %5d %5d \n", row, col);
#endif
	fits_seek(h, row, col);
#ifdef DEBUG2
if (fread(data, 2, 1, ff[h]) != 1) {
fprintf(stderr, "fits_get_data fails to fread\n");
exit(1);
}
printf("read %10d \n", data[0]);
fits_seek(h, row, col);
#endif
	if (fread(data, (bitpix[h]/8), npix, ff[h]) != npix)
		return(FITS_FAIL);
#ifdef DEBUG2
printf("        ");
for (i = 0; i < 5; i++) {
printf("  %6d ", data[i]);
}
printf("\n");
#endif

#ifdef SWAPBYTES
{
	uint16 hibyte, lowbyte;
	int16 swapped;

	for (i = 0; i < npix; i++) {
		lowbyte = ((uint16) data[i]) & 0x00FF;
		hibyte = ((uint16) data[i]) & 0xFF00;
		lowbyte <<= 8;
		hibyte >>= 8;
		swapped = lowbyte | hibyte;
		data[i] = (int16) swapped;
	}
}
#endif


	if (bitpix[h] == 8){
		p=(unsigned char *) data ;
		p += (npix-1);
		for(i=npix-1; i>=0; i--,p--)
			data[i]=(int16)(*p);
	}
		if (scale_flag[h])
			for (i = 0; i < npix; i++) {
				x = (((double) data[i]*bscale[h]) + bzeroe[h]);
				if (x >= MAX_DATA_VAL)
					data[i] = MAX_DATA_VAL;
				else if (x <= MIN_DATA_VAL)
					data[i] = MIN_DATA_VAL;
				else
					data[i] = (int16) x;
			}

	return(FITS_PASS);
}

/******************************************************************************
	fits_put_data

	Write signed integer data to FITS file, starting with (row, col),
	and proceeding for npix pixels.

	12/16/92 use BSCALE and BZERO values, if they already exist for
		this file and aren't 1.0 and 0.0, respectively   MWR
******************************************************************************/

void
fits_put_data(h, row, col, data, npix)
FITS_HANDLE h;
int row;
int col;
int16 *data;
int npix;
{
	fits_seek(h, row, col);

	if (scale_flag[h]) {
		fits_resetscale(h);
	}

#ifdef SWAPBYTES
{
	int i;
	uint16 hibyte, lowbyte;
	int16 swapped;

	for (i = 0; i < npix; i++) {
		lowbyte = ((uint16) data[i]) & 0x00FF;
		hibyte = ((uint16) data[i]) & 0xFF00;
		lowbyte <<= 8;
		hibyte >>= 8;
		swapped = lowbyte | hibyte;
		data[i] = (int16) swapped;
	}
}
#endif


	if (bitpix[h] != 16)
		error(-1, "fits_write -- BITPIX must be 16 for write");
	if (fwrite(data, (bitpix[h]/8), npix, ff[h]) != npix)
	error(-1, "fits_write -- Write failure.");
}

/******************************************************************************
	fits_put_data_fast

	Write data to FITS file,
	with no intermediate seeking
	and proceeding for nwords

	12/16/92 use BSCALE and BZERO values, if they already exist for
		this file and aren't 1.0 and 0.0, respectively   MWR
******************************************************************************/

void
fits_put_data_fast(h, data, nwords)
FITS_HANDLE h;
int16 *data;
int nwords;
{
	if (!fast_done[h]) {
		fits_seek(h, 0, 0);
		fast_done[h] = 1;
	}

	if (scale_flag[h]) {
		fits_resetscale(h);
	}

#ifdef SWAPBYTES
{
	int i;
	uint16 hibyte, lowbyte;
	int16 swapped;

	for (i = 0; i < nwords; i++) {
		lowbyte = ((uint16) data[i]) & 0x00FF;
		hibyte = ((uint16) data[i]) & 0xFF00;
		lowbyte <<= 8;
		hibyte >>= 8;
		swapped = lowbyte | hibyte;
		data[i] = (int16) swapped;
	}
}
#endif

	if (bitpix[h] != 16)
		error(-1, "fits_write -- BITPIX must be 16 for write");

	if (fwrite(data, bitpix[h]/8, nwords, ff[h]) != nwords)
		error(-1, "fits_fast -- Write failure.");
}

/*****************************************************************************
	fits_get_symbol

	Retrieve a FITS header symbol from the header storage area in core.
	Return it in string form.  If symbol is of type string, enclosed in
	quotes, the quotes will be included as part of the string.  Leading
	and trailing blanks otherwise will be trimmed.
****************************************************************************/

int
fits_get_symbol(h, symbol_name, contents)
FITS_HANDLE h;
char *symbol_name;
char *contents;
{
	int ncards;
	char *p;
	int i;

	ncards = (int) (header_length[h] / (long) CARD_LEN);
	p = get_line(h, 1);
	i = 1;
	while (!compar(p, "END") && !compar(p, symbol_name) && (i <= ncards)) {
	i++;
	p = get_line(h, i);
	}
	if (compar(p, symbol_name)) {
			int i, j;
			for (i = 10; p[i] == ' '; i++)          /* skip over leading blanks */
				;
			for (j = 0; i < CARD_LEN;  j++, i++)
/* copy string */
				contents[j] = p[i];
			contents[j] = 0;
			for (j--; (contents[j] == ' ') && (j > 0); j--) /* remove trailing blanks */
				contents[j] = 0;
	return(FITS_PASS);
	}
	else
	return(FITS_FAIL);
}

/*****************************************************************************
	fits_get_headerline

	Retrieve all FITS header line
****************************************************************************/

char *
fits_get_headerline(h,  card_number)
FITS_HANDLE h;
int card_number;
{
	int ncards;

	ncards = (int) (header_length[h] / (long) CARD_LEN);
	if ((card_number > ncards) || (card_number < 1))
		return(NULL);
	return(get_line(h, card_number));
}

/*****************************************************************************
	fits_put_headerline

	Install FITS header line
		in last place and moves the END statement
****************************************************************************/

int
fits_put_headerline(h,  msg)
FITS_HANDLE h;
char *msg;
{
	char *p;
	int i, card, ncards;

	ncards = (int) (header_length[h] / (long) CARD_LEN);
	put_symbol_flag[h] = 1;
	for (card = 1, p = get_line(h, 1); !compar(p, "END"); card++) {
		if (card == ncards) {
			enlarge_header(h);
			ncards = (int) (header_length[h] / (long) CARD_LEN);
			card = 1;
		}
		p = get_line(h, card);
	}
	memset(p, ' ', 80);
	for (i = 0; msg[i] && (i < 80) ; i++)
		p[i] = msg[i];
	p = get_line(h, card++);
	memset(p, ' ', 80);
	inject(p, "END", 3);
	return(FITS_PASS);
}

/*****************************************************************************
	fits_put_symbol

	Update a FITS header symbol, or create a new one in the storage
	area in core.
****************************************************************************/

int
fits_put_symbol(h, symbol_name, contents)
FITS_HANDLE h;
char *symbol_name;
char *contents;
{
	int ncards;
	char *p;
	int i, len;

TOP:
	ncards = (int) (header_length[h] / (long) CARD_LEN);
	p = get_line(h, 1);
	i = 1;
	put_symbol_flag[h] = 1;
	while (!compar(p, "END") && !compar(p, symbol_name) && (i <= ncards)) {
		i++;
		p = get_line(h, i);
	}
	if (i >= ncards) {
		enlarge_header(h);
		goto TOP;
	}
	if (compar(p, symbol_name)) {
		memset(p+9, ' ', 70);           /* fill out with blanks */
		len = strlen(contents);
		if (len > OBJECT_LEN) {
			len = OBJECT_LEN;
		}
		inject(p + 10, contents, len);
	}
	else {
		memset(p, ' ', 80);             /* fill out with blanks */
		len = strlen(symbol_name);
		if (len > SYMBOL_LEN) {
			len = SYMBOL_LEN;
		}
		inject(p, symbol_name, len);
		p[8] = '=';
		len = strlen(contents);
		if (len > (CARD_LEN - (SYMBOL_LEN + 4))) {
			len = CARD_LEN - (SYMBOL_LEN + 4);
		}
		inject(p + 10, contents, len);
		p = get_line(h, i+1);
		inject(p, "END", 3);
	}
	return(FITS_PASS);
}

/*****************************************************************************
	fits_cut

	cuts file opened in "x" mode to max length. Fill the space between
	the last pixel's data and the end of that record (of 2880 bytes) with
	zeros.

	1/24/94 - bitpix !=16 support added -rrt
*****************************************************************************/

void
fits_cut(h)
FITS_HANDLE h;
{
	int16 i;
	long pos, last_data_pos, num_rec;

	last_data_pos = (bitpix[h]/8)*((long)nrow[h]*ncol[h]) + 
                           header_length[h];

	/* position to exact multiple of header */
	num_rec = (last_data_pos + HEADER_LENGTH - 1)/HEADER_LENGTH;
	pos = num_rec*HEADER_LENGTH;    

	if (fseek(ff[h], last_data_pos, 0)) {
		error(-1, "seek error");
	}
	i = 0;
	while (last_data_pos < pos) {
		if (fwrite((char *)&i, 2, 1, ff[h]) != 1) {
			error(-1, "fits_cut -- error padding file with zeros");
		}
		last_data_pos += 2;
	}
	fflush(ff[h]);
#ifdef LINUX
	ftruncate(ff[h]->_fileno, pos);
#else
	ftruncate(fileno(ff[h]), pos);
#endif

}

/*****************************************************************************
	fits_close

	Close designated FITS file.  Update header.
*****************************************************************************/

void
fits_close(h)
FITS_HANDLE h;
{
	int retval;

	if (put_symbol_flag[h]) {
#ifdef LINUX
		retval = fseek(ff[h], (long) 0, SEEK_SET);
#else
		retval = fseek(ff[h], (long) 0, 0);
#endif
		if (retval != 0) {
			error(-1, "fits_close: fseek fails");
		}

		if ((retval = fwrite(header[h], 1, header_length[h], ff[h]))
                                        != header_length[h]) {
			error(-1, "error writing header");
                }
		fflush(ff[h]);
		fits_cut(h);            /* pad end of file with zeros */
	}
	fast_done[h] = 0;
	free(header[h]);        /* release header buffer area */
	header_length[h] = HEADER_LENGTH;
	is_used[h] = 0;
	fclose(ff[h]);
}


/****************************************************************************
   fits_copyheader

	copies the extra stuff in a fits header from one opened handle to another;
	it first skips over the dull 'SIMPLE=T' and 'NAXIS' stuff
	Watch out since NROW and NCOL better be the same

	modified 8/1/1993 by MWR:
	   - checks that NROW, NCOL are the same for both images
	   - sets the BSCALE, BZERO values of the 'out' header to be
	       the same as those of the 'in' header.
	   - if checkflag == FITS_NOCHECK, doesn't enforce NROW and NCOL
	       equality (for window.c)
****************************************************************************/


#define START_CARD 6

void 
fits_copyheader(in, out, checkflag)
FITS_HANDLE in,out;
int checkflag;
{
	int line = START_CARD;
	char *card, buf[200];

	if (checkflag != FITS_NOCHECK) {
		if (nrow[in] != nrow[out]) {
			sprintf(buf, "fits_copyheader: file %s NROW=%d doesn't match file %s NROW=%d",
					f_name[in], nrow[in], f_name[out], nrow[out]);
			error(1, buf);
		}
		if (ncol[in] != ncol[out]) {
			sprintf(buf, "fits_copyheader: file %s NCOL=%d doesn't match file %s NCOL=%d",
					f_name[in], ncol[in], f_name[out], ncol[out]);
			error(1, buf);
		}
	}

	scale_flag[out] = scale_flag[in];
	bscale[out] = bscale[in];
	bzeroe[out] = bzeroe[in];


	while((card=fits_get_headerline(in,line++)) != NULL){
		if(strncmp(card,"END",3) == 0 )
			break;
		if(fits_put_headerline(out,card) == FITS_FAIL)
			error(1,"error in fits_copyheader");
	}
	/* now make sure that BSCALE and BZERO are in the 'out' file's
	   FITS header; add them if they aren't, and make sure the
	   values are the same as the 'in' file's. */
	sprintf(buf, "%e", bscale[in]);
	fits_put_symbol(out, "BSCALE", buf);
	sprintf(buf, "%e", bzeroe[in]);
	fits_put_symbol(out, "BZERO", buf);

}

/****************************************************************************
   fits_resetscale

	this function sets BSCALE=1 and BZERO=0 for its file.  It is necessary
	to call this function after any arithmetic operation on an image,
	since the result of all calculations is stored in 16-bit signed
	integers.  This is a kludge, really, but there's no way around it
	except for keeping an entire image array in memory at once - which
	is what one needs to do in order to figure out the proper BSCALE
	and BZERO values.  
****************************************************************************/

void
fits_resetscale(h)
FITS_HANDLE h;
{
	char buf[200];

	scale_flag[h] = 0;
	bscale[h] = 1.0;
	bzeroe[h] = 0.0;
	sprintf(buf, "%e", bscale[h]);
	fits_put_symbol(h, "BSCALE", buf);
	sprintf(buf, "%e", bzeroe[h]);
	fits_put_symbol(h, "BZERO", buf);
}


/***************************
	Private...
***************************/

static char *
get_line(h, card)
FITS_HANDLE h;
int card;
{
	return(&(header[h][(card - 1)*CARD_LEN]));
}

/*	1/24/94 - bitpix !=16 added rrt*/
static void
fits_seek(h, row, col)
FITS_HANDLE h;
int row, col;
{
	long pos;

	pos = (bitpix[h]/8)*((long)row*ncol[h] + col) + header_length[h];
	if (fseek(ff[h], pos, 0))
		error(-1, "seek error");
#ifdef DEBUG2
printf("pos is %10ld\n", ftell(ff[h]));
#endif
}


static int
compar(str1, str2)
char str1[], str2[];
{
	int i, n1, n2;
	int outcome;

	i = 0;
	while ((str1[i] != ' ') && (str1[i] != '=') && (str1[i] != '\0'))
		i++;
	n1 = i;
	i = 0;
	while ((str2[i] != ' ') && (str2[i] != '=') && (str2[i] != '\0'))
		i++;
	n2 = i;
	outcome = (n1 == n2) && (n1 > 0);
	if (outcome)
		outcome = (strncmp(str1, str2, n1) == 0);
	return(outcome);
}

static void
inject(p, string, nchar)                /* Non-zero terminated copy */
char *p, *string;
int nchar;
{
int i;

	for (i = 0; i < nchar; i++)
		p[i] = string[i];
}


	/* make the header for a FITS file larger by HEADER_LENGTH, copying the
	header that already exists into the new one and filling the new
	area with blanks. */

	/* bug fixed by MWR 1/22/92: we must also copy all the DATA in the file
	since we're about to overwrite a chunk of it.

	11/19/92 tinkered by RRT to put bizarre extension
	*/


static void
enlarge_header(h)
FITS_HANDLE h;
{
	char str[128], *p, newfile[128];
	int16 buf[NMAX];
	int new_hdr_length, nh, row, nc, nr;
	long pos;

	pos = ftell(ff[h]);
	new_hdr_length = header_length[h] + HEADER_LENGTH;

	/* create a new FITS  by adding Bizarre extension*/

#ifdef LINUX
	sprintf(newfile,"%s%d",f_name[h], getpid());
#else
	sprintf(newfile,"%s%ld",f_name[h], getpid());
#endif
	nc = ncol[h];
	nr = nrow[h];
	nh = fits_open(newfile, "w", &nr, &nc);

	if ((p = (char *)malloc(new_hdr_length)) == NULL) {
		sprintf(str, "enlarge_header -- can't malloc for header");
		error(-1, str);
	}
	strncpy(p, header[h], header_length[h]);
	memset(p + header_length[h], ' ', HEADER_LENGTH);
	header[nh] = p;
	header_length[nh] = new_hdr_length;
	free(header[h]);

	/* copy the old header information into this new file */
	fseek(ff[nh], (long) 0, 0);
	fwrite(header[nh], 1, header_length[nh], ff[nh]);

	/* copy all the data from the old file to the new file */
	for (row = 0; row < nrow[h]; row++) {
		fits_get_data(h, row, 0, buf, ncol[h]);
		fits_put_data_fast(nh, buf, ncol[h]);
	}
	fast_done[nh] = 0;
#ifdef FFF
	free(header[nh]);       /* release header buffer area */
#endif
	header_length[nh] = HEADER_LENGTH;
	fclose(ff[h]);
	fclose(ff[nh]);
	handle--;

	/* now, close the old file, and unlink it, then link the new file
	   into its place */
	if (unlink(f_name[h]) != 0) {
		sprintf(str, "enlarge_header -- can't unlink file %s", f_name[h]);
		error(-1, str);
	}
	if (link(f_name[nh], f_name[h]) != 0) {
		perror("unlink");
		sprintf(str, "enlarge_header -- can't link file %s and %s",
					newfile, f_name[h]);
		error(-1, str);
	}
	if (unlink(f_name[nh]) != 0) {
		sprintf(str, "enlarge_header -- can't unlink file %s", newfile);
		error(-1, str);
	}

	if ((ff[h] = fopen(f_name[h], "r+")) == NULL) {
		sprintf(str, "enlarge_header -- Can't open file %s", f_name[h]);
		error(-1, str);
	}

	header[h] = p;
	header_length[h] = new_hdr_length;
	fseek(ff[h], pos, 0);
}

/*      returns the file pointer to the file
	first trying 'name.fts', then 'name'

	It returns the name actually found
*/

static FILE *file_open(name,mode)
char *name,*mode;
{
	static FILE *fret;
	char test[128];
	struct stat file_stat;

	strcpy(test,name);
	if(strcmp(mode,"w") == 0){
		exten_with_care(test);
	}else
		strcat(test,FITS_EXTENSION);



	if( (strcmp(mode,"w") == 0) || stat(test,&file_stat) == 0){
		fret=fopen(test,mode);
		if(fret == NULL){
			char buf[80];
			sprintf(buf, "fits_open -- file %s can't be opened in mode %s",
			test,mode);
			error(1,buf);
		}
		strcpy(name,test);
		return fret;
	}

	strcpy(test,name);
	if(stat(test,&file_stat) == 0){
		fret=fopen(test,mode);
		if(fret == NULL){
			char buf[80];
			sprintf(buf, "fits_open -- file %s can't be opened in mode %s",
			test,mode);
			error(1,buf);
		}
		strcpy(name,test);
		return fret;
	}

	sprintf(name,"%s or [%s]",test,FITS_EXTENSION);
	return NULL;
}

/*      insane procedure to add FTS_EXTENSION only if it needs it
	we try to do the following:
	Case            in                              out
	A.                      foo.fts   -->    foo.fts
	B.                      foo.xyz  -->     foo.xyz
	C.                      foo   -->        foo.fts
	Furthermore we shouldn't get confused by '.'s in
	the front of a path e.g.  ../foo.xyz
*/

static void exten_with_care(in)
char *in;
{
	int n,nfts;
	char *tail;

	/* first check for case A and do nothing */
	n=strlen(in);
	nfts=strlen(FITS_EXTENSION);

	if(n>nfts){
		if(strncmp(in-nfts,FITS_EXTENSION,nfts) == 0 )
			return;
	}
	tail=strrchr(in,'/');
	if (tail == NULL)
		tail=in;

	/*      this is case B */
	if(strchr(tail,'.') != NULL)
		return;

	/* finally case C */

	strcat(in,FITS_EXTENSION);
}

	/* return the index of the first element of "is_used[]" which
	is zero; that's the integer we'll assign as the file handle
	for the FITS file we're about to open.

	if there are NO elements with zero, then all FITS files are
	currently being used; return -1, signaling that we can't
	open any more files */

static int
get_next_handle()
{
	int i;

	for (i = 0; i < NHANDLE; i++)
		if (is_used[i] == 0)
			return(i);
	return(-1);
}


/*	does a floating point compare
		returns 1 if substantially equal
*/

#define TINY 1.0E-4

static int
fequal(a,b)
double a,b;
{
	if(fabs(a-b) > TINY)
		return 0;
	else
		return 1;
}