diff options
Diffstat (limited to 'ast/ffitschan.c')
-rw-r--r-- | ast/ffitschan.c | 1023 |
1 files changed, 0 insertions, 1023 deletions
diff --git a/ast/ffitschan.c b/ast/ffitschan.c deleted file mode 100644 index ef1b83e..0000000 --- a/ast/ffitschan.c +++ /dev/null @@ -1,1023 +0,0 @@ -/* -*+ -* Name: -* ffitschan.c - -* Purpose: -* Define a FORTRAN 77 interface to the AST FitsChan class. - -* Type of Module: -* C source file. - -* Description: -* This file defines FORTRAN 77-callable C functions which provide -* a public FORTRAN 77 interface to the FitsChan class. - -* Routines Defined: -* AST_DELFITS -* AST_PURGEWCS -* AST_FINDFITS -* AST_FITSCHAN -* AST_ISAFITSCHAN -* AST_PUTCARDS -* AST_PUTFITS -* AST_RETAINFITS -* AST_SETFITS<X> -* AST_GETFITS<X> - -* Copyright: -* Copyright (C) 1997-2006 Council for the Central Laboratory of the -* Research Councils - -* Licence: -* This program is free software: you can redistribute it and/or -* modify it under the terms of the GNU Lesser General Public -* License as published by the Free Software Foundation, either -* version 3 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 Lesser General Public License for more details. -* -* You should have received a copy of the GNU Lesser General -* License along with this program. If not, see -* <http://www.gnu.org/licenses/>. - -* Authors: -* DSB: D.S. Berry (Starlink) - -* History: -* 11-DEC-1996 (DSB): -* Original version. -* 21-FEB-1997 (DSB): -* Added source and sink functions to AST_FITSCHAN. -* 20-MAR-1997 (DSB): -* Functions for accessing named keywords removed. Others renamed. -* 28-APR-1997 (DSB): -* FindFits and GetFits merged. -* 10-SEP-2004 (TIMJ): -* Only copy the fits header to fortran string if it was found -* by astFindFits. -* 17-NOV-2004 (DSB): -* Added AST_SETFITS<X> -* 7-OCT-2005 (DSB): -* Added AST_GETFITS<X> -*/ - -/* Define the astFORTRAN77 macro which prevents error messages from - AST C functions from reporting the file and line number where the - error occurred (since these would refer to this file, they would - not be useful). */ -#define astFORTRAN77 - -/* Header files. */ -/* ============= */ -#include "ast_err.h" /* AST error codes */ -#include "f77.h" /* FORTRAN <-> C interface macros (SUN/209) */ -#include "c2f77.h" /* F77 <-> C support functions/macros */ -#include "error.h" /* Error reporting facilities */ -#include "memory.h" /* Memory handling facilities */ -#include "object.h" /* C interface to the base Object class */ -#include "fitschan.h" /* C interface to the FitsChan class */ - -#include <stddef.h> -#include <string.h> - -/* Prototypes for private functions. */ -/* ================================= */ -static char *SourceWrap( const char *(*)( void ), int * ); -static void SinkWrap( void (*)( const char * ), const char *, int * ); -static void TabSourceWrap( void (*)( void ), - AstFitsChan *, const char *, int, int, int * ); - -/* Prototypes for external functions. */ -/* ================================== */ -/* This is the null function defined by the FORTRAN interface in fobject.c. */ -F77_SUBROUTINE(ast_null)( void ); - -/* Source and sink function interfaces. */ -/* ==================================== */ -/* These functions are concerned with allowing FORTRAN implementations - of FitsChan source and sink functions to be passed to the FitsChan - class and invoked when necessary by C code in the main class - implementation. All FORTRAN-specific aspects of this interface are - encapsulated here. */ -static void SinkWrap( void (* sink)( const char * ), const char *line, - int *status ) { -/* -* Name: -* SinkWrap - -* Purpose: -* Wrapper function to invoke a FORTRAN FitsChan sink function. - -* Type: -* Private function. - -* Synopsis: -* static void SinkWrap( void (* sink)( const char * ), const char *line, -* int *status ) - -* Description: -* This function invokes the sink function whose pointer is -* supplied in order to write an output line to an external data -* store. - -* Parameters: -* sink -* Pointer to a sink function. This should result from a cast -* applied to a pointer to a function (with two FORTRAN -* arguments: a character string of length 80 to receive a FITS -* card and an integer error status), that returns void. This -* is the form of FitsChan sink function employed by the FORTRAN -* language interface to the AST library. -* status -* Pointer to inherited status value. -*/ - -/* Local Variables: */ - DECLARE_CHARACTER(CARD,80); - DECLARE_INTEGER(STATUS); - char *d; - const char *c; - int i,lim; - -/* Check the global error status. */ - if ( !astOK ) return; - -/* Copy the supplied null terminated string to a fixed length, blank - padded string which can be passed to the Fortran routine. */ - c = line; - d = CARD; - - lim = (int) strlen( line ); - if( lim > 80 ) lim = 80; - - for( i = 0; i < lim; i++ ){ - *(d++) = (*c++); - } - - for( ; i < 80; i++ ){ - *(d++) = ' '; - } - -/* Cast the sink function pointer to a pointer to the FORTRAN - subroutine and then invoke it. Transfer the AST error status to and - from the subroutine's error status argument. */ - STATUS = astStatus; - ( ( void (*)() ) sink )( CHARACTER_ARG(CARD), INTEGER_ARG(&STATUS) - TRAIL_ARG(CARD) ); - astSetStatus( STATUS ); -} - -static char *SourceWrap( const char *(* source)( void ), int *status ) { -/* -* Name: -* SourceWrap - -* Purpose: -* Wrapper function to invoke a FORTRAN FitsChan source function. - -* Type: -* Private function. - -* Synopsis: -* static char *SourceWrap( const char *(* source)( void ), int *status ) - -* Description: -* This function invokes the source function whose pointer is -* supplied in order to read the next input line from an external -* data store. It then returns a pointer to a dynamic string -* containing a copy of the text that was read. - -* Parameters: -* source -* Pointer to a source function. This should result from a cast -* applied to a pointer to a function (with two FORTRAN -* arguments: a character string of length 80 to return a FITS -* card and an integer error status), that returns a Fortran -* integer. This is the form of FitsChan source function -* employed by the FORTRAN language interface to the AST -* library. -* status -* Pointer to inherited status. - -* Returned Value: -* A pointer to a dynamically allocated, null terminated string -* containing a copy of the text that was read. This string must be -* freed by the caller (using astFree) when no longer required. -* -* A NULL pointer will be returned if there is no more input text -* to read. - -* Notes: -* - A NULL pointer value will be returned if this function is -* invoked with the global error status set or if it should fail -* for any reason. -*/ - -/* Local Variables: */ - DECLARE_CHARACTER(CARD,81); /* Fixed length Fortran string */ - DECLARE_INTEGER(STATUS); /* Fortran error status value */ - char *result; /* Result pointer to return */ - int retval; /* Value returned by source subroutine */ - -/* Initialise. */ - result = NULL; - -/* Check the global error status. */ - if ( !astOK ) return result; - -/* Cast the source function pointer to a pointer to the FORTRAN - function and then invoke it. Transfer the AST error status to and - from the subroutine's error status argument. */ - STATUS = astStatus; - retval = ( *(F77_INTEGER_TYPE (*)()) source )( CHARACTER_ARG(CARD), - INTEGER_ARG(&STATUS) - TRAIL_ARG(CARD) ); - astSetStatus( STATUS ); - -/* If a card was returned, make a dynamic copy of it. */ - if ( astOK && retval ) result = astString( CARD, 80 ); - -/* Return the result. */ - return result; -} - -static void TabSourceWrap( void (*tabsource)( void ), - AstFitsChan *this, const char *extname, - int extver, int extlevel, int *status ){ -/* -* Name: -* TabSourceWrap - -* Purpose: -* Wrapper function to invoke the F77 table source function. - -* Type: -* Private function. - -* Synopsis: -* void TabSourceWrap( void (*tabsource)( void ), -* AstFitsChan *this, const char *extname, -* int extver, int extlevel, int *status ){ - -* Class Membership: -* Channel member function. - -* Description: -* This function invokes the table source function whose pointer is -* supplied in order to read a named FITS binary table from an external -* FITS file. - -* Parameters: -* tabsource -* Pointer to the C tab source function. -* this -* Pointer to the FitsChan. It's reference count will be decremented -* by this function. -* extname -* Pointer to the string holding the name of the FITS extension -* from which a table is to be read. -* extver -* FITS "EXTVER" value for required extension. -* extlevel -* FITS "EXTLEVEL" value for required extension. -* status -* Pointer to the inherited status variable. - -*/ - -/* Local Variables: */ - DECLARE_CHARACTER(EXTNAME,80); - DECLARE_INTEGER(THIS_ID); - DECLARE_INTEGER(LSTAT); - DECLARE_INTEGER(EXTVER); - DECLARE_INTEGER(EXTLEVEL); - AstObject *this_id; - char *d; - const char *c; - int i; - int lim; - -/* Check the global error status. */ - if ( !astOK ) return; - -/* Get an external identifier for the FitsChan. Note, this does not - increment the Object's reference count. Cannot use astClone as we - are in a "public" environment and so astClone would require an object - identifier, not a true C pointer. So the calling function should clone - the pointer before calling this function to avoid the reference count - dropping to zero when the associated identifier is annulled at the end of - this function. */ - this_id = astMakeId( this ); - THIS_ID = astP2I( this_id ); - -/* Export the extver and extlevel values */ - EXTVER = extver; - EXTLEVEL = extlevel; - -/* Copy the supplied null terminated string to a fixed length, blank - padded string which can be passed to the Fortran routine. */ - c = extname; - d = EXTNAME; - - lim = (int) strlen( extname ); - if( lim > 80 ) lim = 80; - - for( i = 0; i < lim; i++ ){ - *(d++) = (*c++); - } - - for( ; i < 80; i++ ){ - *(d++) = ' '; - } - -/* Invoke the table source function (casting it to the F77 API first) to - read the table, and store it in the FitsChan. */ - if( astOK ) { - LSTAT = 0; - ( ( void (*)() ) tabsource )( - INTEGER_ARG(&THIS_ID), CHARACTER_ARG(EXTNAME), INTEGER_ARG(&EXTVER), - INTEGER_ARG(&EXTLEVEL), INTEGER_ARG(&LSTAT) TRAIL_ARG(EXTNAME) ); - } - -/* Report an error if the source function failed. */ - if( LSTAT ) { - if( astOK ) { - astError( AST__NOTAB, "astRead(%s): The table source function failed to read " - "a binary table from extension %s in an external FITS file.", - status, astGetC( this_id, "Class" ), extname ); - } else { - astError( astStatus, "astRead(%s): The table source function failed to read " - "a binary table from extension %s in an external FITS file.", - status, astGetC( this_id, "Class" ), extname ); - } - } - - -/* Free the external identifier for the FitsChan. Note, this decrements - the Object reference count. See comments above. */ - (void) astAnnulId( this_id ); - -} - -/* FORTRAN interface functions. */ -/* ============================ */ -/* These functions implement the remainder of the FORTRAN interface. */ -F77_INTEGER_FUNCTION(ast_fitschan)( F77_INTEGER_TYPE (* SOURCE)(), - void (* SINK)(), - CHARACTER(OPTIONS), - INTEGER(STATUS) - TRAIL(OPTIONS) ) { - GENPTR_CHARACTER(OPTIONS) - F77_INTEGER_TYPE(RESULT); - char *options; - const char *(* source)( void ); - int i; - void (* sink)( const char * ); - - astAt( "AST_FITSCHAN", NULL, 0 ); - astWatchSTATUS( - -/* Set the source and sink function pointers to NULL if a pointer to - the null routine AST_NULL has been supplied. */ - source = (const char *(*)( void )) SOURCE; - if ( source == (const char *(*)( void )) F77_EXTERNAL_NAME(ast_null) ) { - source = NULL; - } - sink = (void (*)( const char * )) SINK; - if ( sink == (void (*)( const char * )) F77_EXTERNAL_NAME(ast_null) ) { - sink = NULL; - } - options = astString( OPTIONS, OPTIONS_length ); - -/* Truncate the options string to exlucde any trailing spaces. */ - astChrTrunc( options ); - -/* Change ',' to '\n' (see AST_SET in fobject.c for why). */ - if ( astOK ) { - for ( i = 0; options[ i ]; i++ ) { - if ( options[ i ] == ',' ) options[ i ] = '\n'; - } - } - RESULT = astP2I( astFitsChanFor( source, SourceWrap, sink, SinkWrap, - "%s", options ) ); - astFree( options ); - ) - return RESULT; -} - -F77_LOGICAL_FUNCTION(ast_isafitschan)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - F77_LOGICAL_TYPE(RESULT); - - astAt( "AST_ISAFITSCHAN", NULL, 0 ); - astWatchSTATUS( - RESULT = astIsAFitsChan( astI2P( *THIS ) ) ? F77_TRUE : F77_FALSE; - ) - return RESULT; -} - -F77_SUBROUTINE(ast_putcards)( INTEGER(THIS), - CHARACTER(CARDS), - INTEGER(STATUS) - TRAIL(CARDS) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(CARDS) - char *cards; - - astAt( "AST_PUTCARDS", NULL, 0 ); - astWatchSTATUS( - cards = astString( CARDS, CARDS_length ); - astPutCards( astI2P( *THIS ), cards ); - (void) astFree( (void *) cards ); - ) -} - -F77_SUBROUTINE(ast_putfits)( INTEGER(THIS), - CHARACTER(CARD), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(CARD) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(CARD) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *card; - - astAt( "AST_PUTFITS", NULL, 0 ); - astWatchSTATUS( - card = astString( CARD, CARD_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astPutFits( astI2P( *THIS ), card, overwrite ); - (void) astFree( (void *) card ); - ) -} - -F77_SUBROUTINE(ast_delfits)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - - astAt( "AST_DELFITS", NULL, 0 ); - astWatchSTATUS( - astDelFits( astI2P( *THIS ) ); - ) -} - -F77_SUBROUTINE(ast_purgewcs)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - - astAt( "AST_PURGEWCS", NULL, 0 ); - astWatchSTATUS( - astPurgeWCS( astI2P( *THIS ) ); - ) -} - -F77_SUBROUTINE(ast_retainfits)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - - astAt( "AST_RETAINFITS", NULL, 0 ); - astWatchSTATUS( - astRetainFits( astI2P( *THIS ) ); - ) -} - -F77_LOGICAL_FUNCTION(ast_findfits)( INTEGER(THIS), - CHARACTER(NAME), - CHARACTER(CARD), - LOGICAL(INC), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(CARD) ){ - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_CHARACTER(CARD) - GENPTR_LOGICAL(INC) - F77_LOGICAL_TYPE(RESULT); - int i, len; - char *name; - char card[ 81 ]; - int inc; - - astAt( "AST_FINDFITS", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - inc = F77_ISTRUE( *INC ); - RESULT = astFindFits( astI2P( *THIS ), name, card, inc ) ? - F77_TRUE : F77_FALSE; - i = 0; - if ( astOK && F77_ISTRUE(RESULT) ) { - len = (int) strlen( card ); - for( i = 0; i < CARD_length && i < len; i++ ) CARD[i] = card[i]; - } - for( ; i < CARD_length; i++ ) CARD[i] = ' '; - (void) astFree( (void *) name ); - ) - return RESULT; -} - - -F77_SUBROUTINE(ast_setfitsf)( INTEGER(THIS), - CHARACTER(NAME), - DOUBLE(VALUE), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_DOUBLE(VALUE) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *name, *comment; - - astAt( "AST_SETFITSF", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsF( astI2P( *THIS ), name, *VALUE, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) comment ); - ) -} - -F77_SUBROUTINE(ast_setfitsu)( INTEGER(THIS), - CHARACTER(NAME), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *name, *comment; - - astAt( "AST_SETFITSU", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsU( astI2P( *THIS ), name, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) comment ); - ) -} - -F77_SUBROUTINE(ast_setfitscm)( INTEGER(THIS), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *comment; - - astAt( "AST_SETFITSCM", NULL, 0 ); - astWatchSTATUS( - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsCM( astI2P( *THIS ), comment, overwrite ); - (void) astFree( (void *) comment ); - ) -} - - -F77_SUBROUTINE(ast_setfitsi)( INTEGER(THIS), - CHARACTER(NAME), - INTEGER(VALUE), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_INTEGER(VALUE) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *name, *comment; - - astAt( "AST_SETFITSI", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsI( astI2P( *THIS ), name, *VALUE, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) comment ); - ) -} - - -F77_SUBROUTINE(ast_setfitscf)( INTEGER(THIS), - CHARACTER(NAME), - DOUBLE_ARRAY(VALUE), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_DOUBLE_ARRAY(VALUE) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *name, *comment; - - astAt( "AST_SETFITSCF", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsCF( astI2P( *THIS ), name, VALUE, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) comment ); - ) -} - - -F77_SUBROUTINE(ast_setfitsci)( INTEGER(THIS), - CHARACTER(NAME), - INTEGER_ARRAY(VALUE), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_INTEGER_ARRAY(VALUE) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *name, *comment; - - astAt( "AST_SETFITSCI", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsCI( astI2P( *THIS ), name, VALUE, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) comment ); - ) -} - - -F77_SUBROUTINE(ast_setfitsl)( INTEGER(THIS), - CHARACTER(NAME), - LOGICAL(VALUE), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_LOGICAL(VALUE) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite, value; - char *name, *comment; - - astAt( "AST_SETFITSL", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - value = F77_ISTRUE( *VALUE ); - astSetFitsL( astI2P( *THIS ), name, value, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) comment ); - ) -} - - -F77_SUBROUTINE(ast_setfitss)( INTEGER(THIS), - CHARACTER(NAME), - CHARACTER(VALUE), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(VALUE) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_CHARACTER(VALUE) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *name, *comment, *value; - - astAt( "AST_SETFITSS", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - value = astString( VALUE, VALUE_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsS( astI2P( *THIS ), name, value, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) value ); - (void) astFree( (void *) comment ); - ) -} - -F77_SUBROUTINE(ast_setfitscn)( INTEGER(THIS), - CHARACTER(NAME), - CHARACTER(VALUE), - CHARACTER(COMMENT), - LOGICAL(OVERWRITE), - INTEGER(STATUS) - TRAIL(NAME) - TRAIL(VALUE) - TRAIL(COMMENT) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_CHARACTER(VALUE) - GENPTR_CHARACTER(COMMENT) - GENPTR_LOGICAL(OVERWRITE) - int overwrite; - char *name, *comment, *value; - - astAt( "AST_SETFITSS", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - value = astString( VALUE, VALUE_length ); - comment = astString( COMMENT, COMMENT_length ); - overwrite = F77_ISTRUE( *OVERWRITE ); - astSetFitsCN( astI2P( *THIS ), name, value, comment, overwrite ); - (void) astFree( (void *) name ); - (void) astFree( (void *) value ); - (void) astFree( (void *) comment ); - ) -} - -#define MAKE_AST_GETFITS(f,F,Ftype,X,Xtype) \ -F77_LOGICAL_FUNCTION(ast_getfits##f)( INTEGER(THIS), \ - CHARACTER(NAME), \ - Ftype(VALUE), \ - INTEGER(STATUS) \ - TRAIL(NAME) ){ \ - GENPTR_INTEGER(THIS) \ - GENPTR_CHARACTER(NAME) \ - GENPTR_##Ftype(VALUE) \ - GENPTR_INTEGER(STATUS) \ - F77_LOGICAL_TYPE(RESULT); \ -\ - char *name; \ - Xtype *value; \ -\ - value = (Xtype *) VALUE; \ -\ - astAt( "AST_GETFITS"#F, NULL, 0 ); \ - astWatchSTATUS( \ - name = astString( NAME, NAME_length ); \ - if( name && !strcmp( name, "." ) ) name = astFree( name ); \ - RESULT = astGetFits##X( astI2P( *THIS ), name, value ) ? \ - F77_TRUE : F77_FALSE; \ - (void) astFree( (void *) name ); \ - ) \ - return RESULT; \ -} - -MAKE_AST_GETFITS(f,F,DOUBLE,F,double) -MAKE_AST_GETFITS(i,I,INTEGER,I,int) -MAKE_AST_GETFITS(l,L,LOGICAL,L,int) -#undef MAKE_AST_GETFITS - - -F77_LOGICAL_FUNCTION(ast_testfits)( INTEGER(THIS), - CHARACTER(NAME), - LOGICAL(THERE), - INTEGER(STATUS) - TRAIL(NAME) ){ - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(NAME) - GENPTR_LOGICAL(THERE) - GENPTR_INTEGER(STATUS) - F77_LOGICAL_TYPE(RESULT); - - char *name; - int there; - - astAt( "AST_TESTFITS", NULL, 0 ); - astWatchSTATUS( - name = astString( NAME, NAME_length ); - if( name && !strcmp( name, "." ) ) name = astFree( name ); \ - RESULT = astTestFits( astI2P( *THIS ), name, &there ) ? - F77_TRUE : F77_FALSE; - (void) astFree( (void *) name ); - ) - *THERE = there ? F77_TRUE : F77_FALSE; - return RESULT; -} - - -#define MAKE_AST_GETFITS(f,F,Ftype,X,Xtype) \ -F77_LOGICAL_FUNCTION(ast_getfits##f)( INTEGER(THIS), \ - CHARACTER(NAME), \ - Ftype##_ARRAY(VALUE), \ - INTEGER(STATUS) \ - TRAIL(NAME) ){ \ - GENPTR_INTEGER(THIS) \ - GENPTR_CHARACTER(NAME) \ - GENPTR_##Ftype##_ARRAY(VALUE) \ - GENPTR_INTEGER(STATUS) \ - F77_LOGICAL_TYPE(RESULT); \ -\ - char *name; \ - Xtype value[2]; \ -\ - astAt( "AST_GETFITS"#F, NULL, 0 ); \ - astWatchSTATUS( \ - name = astString( NAME, NAME_length ); \ - if( name && !strcmp( name, "." ) ) name = astFree( name ); \ - RESULT = astGetFits##X( astI2P( *THIS ), name, value ) ? \ - F77_TRUE : F77_FALSE; \ - VALUE[ 0 ] = (F77_DOUBLE_TYPE) value[ 0 ]; \ - VALUE[ 1 ] = (F77_DOUBLE_TYPE) value[ 1 ]; \ - (void) astFree( (void *) name ); \ - ) \ - return RESULT; \ -} - - -MAKE_AST_GETFITS(cf,CF,DOUBLE,CF,double) -MAKE_AST_GETFITS(ci,CI,INTEGER,CI,int) - -#undef MAKE_AST_GETFITS - -#define MAKE_AST_GETFITS(f,F,X) \ -F77_LOGICAL_FUNCTION(ast_getfits##f)( INTEGER(THIS), \ - CHARACTER(NAME), \ - CHARACTER(VALUE), \ - INTEGER(STATUS) \ - TRAIL(NAME) \ - TRAIL(VALUE) ){ \ - GENPTR_INTEGER(THIS) \ - GENPTR_CHARACTER(NAME) \ - GENPTR_CHARACTER(VALUE) \ - GENPTR_INTEGER(STATUS) \ - F77_LOGICAL_TYPE(RESULT); \ -\ - char *name; \ - int i, len; \ - char *value; \ -\ - astAt( "AST_GETFITS"#F, NULL, 0 ); \ - astWatchSTATUS( \ - name = astString( NAME, NAME_length ); \ - if( name && !strcmp( name, "." ) ) name = astFree( name ); \ - RESULT = astGetFits##X( astI2P( *THIS ), name, &value ) ? \ - F77_TRUE : F77_FALSE; \ - if ( astOK && F77_ISTRUE(RESULT) ) { \ - len = (int) strlen( value ); \ - for( i = 0; i < VALUE_length && i < len; i++ ) VALUE[i] = value[i]; \ - } else { \ - i = 0; \ - } \ - for( ; i < VALUE_length; i++ ) VALUE[i] = ' '; \ - (void) astFree( (void *) name ); \ - ) \ - return RESULT; \ -} - -MAKE_AST_GETFITS(s,S,S) -MAKE_AST_GETFITS(cn,CN,CN) - -#undef MAKE_AST_GETFITS - -F77_SUBROUTINE(ast_readfits)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - - astAt( "AST_READFITS", NULL, 0 ); - astWatchSTATUS( - astReadFits( astI2P( *THIS ) ); - ) -} - -F77_SUBROUTINE(ast_writefits)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - - astAt( "AST_WRITEFITS", NULL, 0 ); - astWatchSTATUS( - astWriteFits( astI2P( *THIS ) ); - ) -} - - -F77_SUBROUTINE(ast_emptyfits)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - - astAt( "AST_EMPTYFITS", NULL, 0 ); - astWatchSTATUS( - astEmptyFits( astI2P( *THIS ) ); - ) -} - -F77_SUBROUTINE(ast_showfits)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - - astAt( "AST_SHOWFITS", NULL, 0 ); - astWatchSTATUS( - astShowFits( astI2P( *THIS ) ); - ) -} - - -F77_INTEGER_FUNCTION(ast_gettables)( INTEGER(THIS), - INTEGER(STATUS) ) { - GENPTR_INTEGER(THIS) - F77_INTEGER_TYPE(RESULT); - - astAt( "AST_GETTABLES", NULL, 0 ); - astWatchSTATUS( - RESULT = astP2I( astGetTables( astI2P( *THIS ) ) ); - ) - return RESULT; -} - -F77_SUBROUTINE(ast_removetables)( INTEGER(THIS), - CHARACTER(KEY), - INTEGER(STATUS) - TRAIL(KEY) ) { - GENPTR_INTEGER(THIS) - GENPTR_CHARACTER(KEY) - char *key; - - astAt( "AST_REMOVETABLES", NULL, 0 ); - astWatchSTATUS( - key = astString( KEY, KEY_length ); - astRemoveTables( astI2P( *THIS ), key ); - (void) astFree( (void *) key ); - ) -} - -F77_SUBROUTINE(ast_puttable)( INTEGER(THIS), - INTEGER(TABLE), - CHARACTER(EXTNAM), - INTEGER(STATUS) - TRAIL(EXTNAM) ){ - GENPTR_INTEGER(THIS) - GENPTR_INTEGER(TABLES) - GENPTR_CHARACTER(EXTNAM) - char *extnam; - - astAt( "AST_PUTTABLE", NULL, 0 ); - astWatchSTATUS( - extnam = astString( EXTNAM, EXTNAM_length ); - astPutTable( astI2P( *THIS ), astI2P( *TABLE ), extnam ); - extnam = astFree( extnam ); - ) -} - -F77_SUBROUTINE(ast_puttables)( INTEGER(THIS), - INTEGER(TABLES), - INTEGER(STATUS) ){ - GENPTR_INTEGER(THIS) - GENPTR_INTEGER(TABLES) - - astAt( "AST_PUTTABLES", NULL, 0 ); - astWatchSTATUS( - astPutTables( astI2P( *THIS ), astI2P( *TABLES ) ); - ) -} - -F77_SUBROUTINE(ast_tablesource)( INTEGER(THIS), - void (* SOURCE)(), - INTEGER(STATUS) ){ - GENPTR_INTEGER(THIS) - void (* source)( void ); - - astAt( "AST_TABLESOURCE", NULL, 0 ); - astWatchSTATUS( - source = (void (*)( void )) SOURCE; - if ( source == (void (*)( void )) F77_EXTERNAL_NAME(ast_null) ) { - source = NULL; - } - astSetTableSource( astI2P( *THIS ), source, TabSourceWrap ); - ) -} - - |