lib/Starlink/AST.xs

/*

  AST.xs

  Copyright (C) 2004-2005 Tim Jenness. All Rights Reserved.

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., 59 Temple
Place,Suite 330, Boston, MA  02111-1307, USA

*/

#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"   /* std perl include */
#include "perl.h"     /* std perl include */
#include "XSUB.h"     /* XSUB include */
#include "ppport.h"
#ifdef __cplusplus
}
#endif

/* for some reason ppport.h does not currently have CopFILE defined */
#ifndef CopFILE
#define CopFILE(s)  "<unknown>"
#endif
#ifndef CopLINE
#define CopLINE(s)  -1
#endif

/* typedef some common types so that the typemap can bless constants
   into correct namespaces */

#include <limits.h>

typedef int StatusType;
typedef int WcsMapType;

#include "ast.h"
#include "grf.h"

/* Older versions of AST can require Fortran, so we add dummy main
   needed by, eg, g95 */
#if ( AST_MAJOR_VERS < 4 )
void MAIN_ () {}
void MAIN__ () {}
#endif


/* The following definitions are required for backwards compatible
   Since AST version 2 does not have these.
*/

#if ( AST_MAJOR_VERS >= 2 )
# define HASSPECFRAME
# define HASSPECMAP
# define HASSPECADD
# define HASSETREFPOS
# define HASGETREFPOS
# define HASGETACTIVEUNIT
# define HASSETACTIVEUNIT
#else
typedef void AstSpecFrame;
typedef void AstSpecMap;
#endif

#if ( AST_MAJOR_VERS >= 3 )
#define HASPOLYMAP
#define HASGRISMMAP
#define HASSHIFTMAP
#define HASRATE
#else
typedef void AstPolyMap;
typedef void AstGrismMap;
typedef void AstShiftMap;
#endif

#if ( (AST_MAJOR_VERS == 3 && AST_MINOR_VERS >= 1) || AST_MAJOR_VERS >= 4 )
#define HASXMLCHAN
#else
typedef void AstXmlChan;
#endif

#if ( (AST_MAJOR_VERS == 5 && AST_MINOR_VERS >= 2) || AST_MAJOR_VERS >= 6 )
#define HASSTCSCHAN
#else
typedef void AstStcsChan;
#endif

#if ( (AST_MAJOR_VERS == 3 && AST_MINOR_VERS >= 2) || AST_MAJOR_VERS >= 4 )
#define HASTRANMAP
#define HASPUTCARDS
#define HASESCAPES
#else
typedef void AstTranMap;
#endif

#if ( (AST_MAJOR_VERS == 3 && AST_MINOR_VERS >= 4) || AST_MAJOR_VERS >= 4 )
#define HASDSBSPECFRAME
#else
typedef void AstDSBSpecFrame;
#endif

#if ( (AST_MAJOR_VERS == 3 && AST_MINOR_VERS >= 5) || AST_MAJOR_VERS >= 4 )
#define HASLINEARAPPROX
#define HASSETFITS
#define HASRATEMAP
#define HASKEYMAP
#define HASFLUXFRAME
#define HASSPECFLUXFRAME
#define HASREGION
#else
typedef void AstRateMap;
typedef void AstKeyMap;
typedef void AstFluxFrame;
typedef void AstSpecFluxFrame;
typedef void AstRegion;
typedef void AstBox;
typedef void AstCircle;
typedef void AstEllipse;
typedef void AstNullRegion;
typedef void AstPolygon;
typedef void AstInterval;
typedef void CmpRegion;
#endif

#if ( (AST_MAJOR_VERS == 3 && AST_MINOR_VERS >= 7) || AST_MAJOR_VERS >= 4 )
#define HASTIMEFRAME
#define HASTIMEMAP
#else
typedef void AstTimeFrame;
typedef void AstTimeMap;
#endif

/* between v3.0 and v3.4 astRate returned the second derivative */
#if ( AST_MAJOR_VERS == 3 && AST_MINOR_VERS < 5 )
#define RATE_HAS_SECOND_DERIVATIVE 1
#endif

#if ( (AST_MAJOR_VERS == 4 && AST_MINOR_VERS >= 1) || AST_MAJOR_VERS >= 5 )
#define HASMAPSPLIT
#else
#endif

#if ( (AST_MAJOR_VERS == 5 && AST_MINOR_VERS >= 3) || AST_MAJOR_VERS >= 6 )
#define HASMAPPUTU
#define HASHASATTRIBUTE
#else
#endif

#if ( (AST_MAJOR_VERS == 5 && AST_MINOR_VERS >= 4) || AST_MAJOR_VERS >= 6 )
#define HASKEYMAPSHORT
#else
#endif

#if ( (AST_MAJOR_VERS == 7 && AST_MINOR_VERS >= 2) || AST_MAJOR_VERS >= 8 )
#define HASMAPDEFINED
#else
#endif


/* Helper functions */
#include "arrays.h"
#include "astTypemap.h"

static char ** pack1Dchar( AV * avref ) {
  int i;
  SV ** elem;
  char ** outarr;
  int len;
  STRLEN linelen;

  /* number of elements */
  len  = av_len( avref ) + 1;
  /* Temporary storage */
  outarr = get_mortalspace( len,'v');

  for (i=0; i<len; i++) {
    elem = av_fetch( avref, i, 0);
    if (elem == NULL ) {
      /* undef */
    } else {
      outarr[i] = SvPV( *elem, linelen);
    }
  }
  return outarr;
}

static AstObject ** pack1DAstObj( AV * avref ) {
  int i;
  SV ** elem;
  AstObject ** outarr;
  int len;

  /* number of elements */
  len  = av_len( avref ) + 1;
  /* Temporary storage - array of pointers */
  outarr = get_mortalspace( len,'v');

  for (i=0; i<len; i++) {
    elem = av_fetch( avref, i, 0);
    if (elem == NULL ) {
      /* undef */
    } else {
      /* Now need to convert this SV** to an AstObject */
      if (sv_derived_from(*elem, "Starlink::AST")) {
	    IV tmpiv = extractAstIntPointer( *elem );
	    outarr[i] = INT2PTR(AstObject *,tmpiv);
      } else {
        Perl_croak( aTHX_ "Array contains non-Starlink::AST variables");
      }
    }
  }
  return outarr;
}

/* This routine should throw an exception of a different
   class depending on the value of the AST status. For
   now we croak with the error message.

   We deliberately try to stay in C here rather than
   add to the complexity by calling out into perl.
*/

static void astThrowException ( int status, AV* errorstack ) {
  size_t i;
  size_t nelem;

  SV * errsv = sv_2mortal( newSVpvn("", 0) );

  nelem = av_len( errorstack );
  for (i = 0; i <= nelem; i++ ) {
    SV ** elem = av_fetch( errorstack, i, 0);
    if (elem != NULL ) {
      sv_catpv( errsv, "- ");
      sv_catsv( errsv, (SV*)*elem);
      if (i != nelem) sv_catpv( errsv, "\n");
    }
  }
  Perl_croak( aTHX_ "%s", SvPV_nolen( errsv ) );
}

/* Callbacks */

/* sourceWrap is called by the fitschan constructor immediately and not
   by the Read method. This means that there are no worries about
   reference counting or keeping copies of the function around.
 */

static char *sourceWrap( const char *(*source)(), int *status ) {
  dSP;
  SV * cb;
  SV * myobject;
  SV * retsv;
  int count;
  STRLEN len;
  char * line;
  char * retval = NULL;

  /* Return directly if ast status is set. */
  if ( !astOK ) return NULL;
  if ( source == NULL ) {
    astError( AST__INTER, "source function called without Perl callback");
    return NULL;
  }

  /* Need to cast the source argument to a SV* and extract the callback from the object */
  myobject = (SV*) source;
  cb = getPerlObjectAttr( myobject, "_source" );
  if (cb == NULL) {
    astError( AST__INTER, "Callback in channel 'source' not defined!");
    return NULL;
  }
  cb = SvRV( cb );

  /* call the callback with the supplied line */
  ENTER;
  SAVETMPS;

  PUSHMARK(sp);
  PUTBACK;

  count = call_sv( cb, G_NOARGS | G_SCALAR | G_EVAL );

  ReportPerlError( AST__INTER );

  SPAGAIN ;

  if (astOK) {
    if (count != 1) {
      astError( AST__INTER, "Returned more than one arg from channel source");
    } else {
      retsv = POPs;

      if (SvOK(retsv)) {
	line = SvPV(retsv, len);

	/* The sourceWrap function must return the line in memory
	   allocated using the AST memory allocator */
	retval = astMalloc( len + 1 );
	if ( retval != NULL ) {
	  strcpy( retval, line );
	}
      } else {
	retval = NULL;
      }
    }
  }

  PUTBACK;
  FREETMPS;
  LEAVE;

  return retval;
}

static void sinkWrap( void (*sink)(const char *), const char *line, int *status ) {
  dSP;
  SV * cb;
  SV * myobject;

  /* Return directly if ast status is set. */
  if ( !astOK ) return;

  /* Need to cast the sink argument to a SV*  */
  myobject = (SV*) sink;

  cb = getPerlObjectAttr( myobject, "_sink" );

  if (cb == NULL) {
    astError( AST__INTER, "Callback in channel 'sink' not defined!");
    return;
  }


  /* call the callback with the supplied line */
  ENTER;
  SAVETMPS;

  PUSHMARK(sp);
  XPUSHs( sv_2mortal( newSVpv( (char*)line, strlen(line) )));
  PUTBACK;

  call_sv( SvRV(cb), G_DISCARD | G_VOID | G_EVAL );

  ReportPerlError( AST__INTER );

  FREETMPS;
  LEAVE;

}


/* Need to allocate a mutex to prevent threads accessing
   the AST simultaneously. May need to protect this from
   non-threaded perl */

#ifdef USE_ITHREADS
static perl_mutex AST_mutex;
#endif

/* An array to store the messages coming from the error system */
AV* ErrBuff;

/* We need to make sure that ast routines are called in a thread-safe
   manner since the underlying AST library is not thread-safe because
   of the error system. Use Mark's JNIAST technique */

#define ASTCALL(code) \
  STMT_START { \
    int my_xsstatus_val = 0; \
    int *my_xsstatus = &my_xsstatus_val; \
    int *old_ast_status; \
    AV* local_err; \
    MUTEX_LOCK(&AST_mutex); \
    My_astClearErrMsg(); \
    old_ast_status = astWatch( my_xsstatus ); \
    code \
    astWatch( old_ast_status ); \
    /* Need to remove the MUTEX before we croak [but must copy the error buffer] */ \
    My_astCopyErrMsg( &local_err, *my_xsstatus ); \
    MUTEX_UNLOCK(&AST_mutex); \
    if ( *my_xsstatus != 0 ) { \
      astThrowException( *my_xsstatus, local_err ); \
    } \
  } STMT_END;


/* When we call plot routines, we need to register the plot object
   in a global variable so that the plotting infrastructure can get
   at the callbacks */

#define PLOTCALL(grfobject,code) \
  ASTCALL( \
    Perl_storeGrfObject( grfobject ); \
    code \
    Perl_clearGrfObject(); \
  )

/* This is the error handler.
 Store error messages in an array. Need to worry about thread-local storage
 very soon.

 This symbol must be available to the AST routines as we are deliberately
 replacing the AST error handler.
 */

void astPutErr_ ( int status, const char * message ) {
  /* the av_clear decrements the refcnt of the SV entries */
  av_push(ErrBuff, newSVpv((char*)message, 0) );
}

static void My_astClearErrMsg () {
  av_clear( ErrBuff );
}

/* routine to copy the error messages from the global array to a private
   array so that we can release the Mutex before the exception is thrown.
   Creates a new mortal AV and populates it.

   This is required because astPutErr can only use the static version
   of the array.

   Does not try to do anything if status is 0
 */

static void My_astCopyErrMsg ( AV ** newbuff, int status ) {
  size_t i;
  size_t nelem;
  if (status == 0) return;

  *newbuff = newAV();
  sv_2mortal((SV*)*newbuff);
  nelem = av_len( ErrBuff );
  for (i = 0; i <= nelem ; i++ ) {
    SV ** elem = av_fetch( ErrBuff, i, 0);
    if (elem != NULL ) {
      SvREFCNT_inc( *elem ); /* Storing it in a new place so inc reference count */
      av_push( *newbuff, *elem);
    }
  }

  /* And we no longer need the error array contents */
  My_astClearErrMsg();

}

/* Since you can not put CPP code within CPP code inside XS we need
   to provide a special wrapper routine for astRate */
static void myAstRate ( AstMapping * this, double * cat, int ax1, int ax2,
                        double * d2) {
  double RETVAL;
  dXSARGS;

#if RATE_HAS_SECOND_DERIVATIVE
  ASTCALL(
    RETVAL = astRate( this, cat, ax1, ax2, d2 );
  )
#else
  ASTCALL(
    RETVAL = astRate( this, cat, ax1, ax2 );
  )
#endif
  if ( RETVAL != AST__BAD ) {
     XPUSHs(sv_2mortal(newSVnv(RETVAL)));
#ifdef RATE_HAS_SECOND_DERIVATIVE
     XPUSHs(sv_2mortal(newSVnv(*d2)));
#endif
  } else {
     XSRETURN_EMPTY;
  }
}


MODULE = Starlink::AST     PACKAGE = Starlink::AST

PROTOTYPES: DISABLE

BOOT:
          MUTEX_INIT(&AST_mutex);
          ErrBuff = newAV();

double
AST__BAD()
 CODE:
#ifdef AST__BAD
    RETVAL = AST__BAD;
#else
    Perl_croak(aTHX_ "Constant AST__BAD not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__CURRENT()
 CODE:
#ifdef AST__CURRENT
    RETVAL = AST__CURRENT;
#else
    Perl_croak(aTHX_ "Constant AST__CURRENT not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__NOFRAME()
 CODE:
#ifdef AST__NOFRAME
    RETVAL = AST__NOFRAME;
#else
    Perl_croak(aTHX_ "Constant AST__NOFRAME not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__BASE()
 CODE:
#ifdef AST__BASE
    RETVAL = AST__BASE;
#else
    Perl_croak(aTHX_ "Constant AST__BASE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__ALLFRAMES()
 CODE:
#ifdef AST__ALLFRAMES
    RETVAL = AST__ALLFRAMES;
#else
    Perl_croak(aTHX_ "Constant AST__ALLFRAMES not defined\n");
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST     PACKAGE = Starlink::AST PREFIX = ast


void
astBegin()
 CODE:
  ASTCALL(
    astBegin;
  )


void
astEnd()
 CODE:
  ASTCALL(
    astEnd;
  )

bool
astEscapes( new_value )
  bool new_value
 CODE:
#ifndef HASESCAPES
   Perl_croak(aTHX_ "astEscapes: Please upgrade to AST V3.2 or greater");
#else
  RETVAL = astEscapes( new_value );
#endif
 OUTPUT:
  RETVAL

# Can be called as class method or function

int
astVersion( ... )
 CODE:
#if ( AST_MAJOR_VERS >= 2 )
  ASTCALL(
   RETVAL = astVersion;
  )
#else
   Perl_croak(aTHX_ "astVersion: Please upgrade to AST V2.x or greater");
#endif
 OUTPUT:
  RETVAL

void
astIntraReg()
 CODE:
   Perl_croak(aTHX_ "astIntraReg Not yet implemented\n");

# The following functions are associated with AST internal status
# They can only be called from within an AST callback (eg the
# graphics system since they do not MUTEX and they do not switch
# the internal status variable.

# Note the use of _ in name

# No need to make this private but we need to make sure
# this is called from within a mutex (so a callback is okay)
# Call is as _OK. but without changing the current status integer

bool
ast_OK()
 CODE:
  RETVAL = astOK;
 OUTPUT:
  RETVAL

# Called only from within AST callbacks. No MUTEX locking.

void
ast_Error( status, message)
  StatusType status
  char * message
 CODE:
  astError( status, "%s", message);


# Call only from within an AST callback

void
ast_ClearStatus()
 CODE:
   astClearStatus;

void
ast_SetStatus( status )
  StatusType status
 CODE:
   astSetStatus( status );

StatusType
ast_Status()
 CODE:
   RETVAL = astStatus;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::Status

# Translate status values
int
value( this )
  StatusType this
 CODE:
  RETVAL = this;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::Frame

AstFrame *
new( class, naxes, options )
  char * class
  int naxes
  char * options
 CODE:
  ASTCALL(
   RETVAL = astFrame( naxes, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::FrameSet

AstFrameSet *
new( class, frame, options )
  char * class
  AstFrame * frame
  char * options
 CODE:
  ASTCALL(
   RETVAL = astFrameSet( frame, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::CmpFrame

AstCmpFrame *
new( class, frame1, frame2, options )
  char * class
  AstFrame * frame1
  AstFrame * frame2
  char * options
 CODE:
  ASTCALL(
   RETVAL = astCmpFrame( frame1, frame2, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::FluxFrame

AstFluxFrame *
new( class, specval, specfrm, options )
  char * class
  double specval
  AstSpecFrame * specfrm
  char * options
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astFluxFrame: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   RETVAL = astFluxFrame( specval, specfrm, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::SpecFluxFrame

AstSpecFluxFrame *
new( class, frame1, frame2, options )
  char * class
  AstSpecFrame * frame1
  AstFluxFrame * frame2
  char * options
 CODE:
#ifndef HASSPECFLUXFRAME
  Perl_croak(aTHX_ "astSpecFluxFrame: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   RETVAL = astSpecFluxFrame( frame1, frame2, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::CmpMap

AstCmpMap *
new( class, map1, map2, series, options )
  char * class
  AstMapping * map1
  AstMapping * map2
  int series
  char * options
 CODE:
  ASTCALL(
   RETVAL = astCmpMap( map1, map2, series, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::Channel

# Need to add proper support for the callbacks. Currently rely on the
# returned object to keep a reference to the callback.

# Note that we use inheritance here so we have to switch on the basis
# of the supplied class. Things will get difficult if people start
# adding their own subclasses since I am only looking at substring
# matches.

SV *
_new( class, sourcefunc, sinkfunc, options )
  char * class
  SV * sourcefunc
  SV * sinkfunc
  char * options;
 PREINIT:
  SV ** value;
  SV * sink = NULL;
  SV * source = NULL;
  AstChannel * channel;
  AstFitsChan * fitschan;
  AstXmlChan * xmlchan;
  AstStcsChan * stcschan;
  bool has_source = 0;
  bool has_sink = 0;
 CODE:
  /* create the object without a pointer */
  RETVAL = createPerlObject( class, NULL );

  /* Decide whether to register a callback with the sink/source.
     Do this rather than always registering callback for efficiency reasons
     and because I am not sure if the presence of a callback affects the
     behaviour of the channel. */

  /* First see whether we were given valid callbacks */
  if (SvOK(sourcefunc) && SvROK(sourcefunc) &&
        SvTYPE(SvRV(sourcefunc)) == SVt_PVCV) has_source = 1;
  if (SvOK(sinkfunc) && SvROK(sinkfunc) &&
        SvTYPE(SvRV(sinkfunc)) == SVt_PVCV) has_sink = 1;

  if ( has_source || has_sink) {
    /* Take a reference to the object but do not increment the REFCNT. We
       Want this to be freed when the perl object disappears. */
    /* only take one reference */

    /* For sink functions we have to keep them around in the object
       since they are called when the object is annulled. */
    SV * rv = newRV_noinc( SvRV( RETVAL ));
    if (has_sink) {
      /* Store reference to object */
      sink = rv;
      /* and store the actual sink callback in the object */
      setPerlObjectAttr( RETVAL, "_sink", newRV_inc( SvRV(sinkfunc) ));
    }

    /* In some cases the source routine is called after this constructor
       returns. We therefore need to store the source function in the object
       as well. */
    if (has_source) {
      /* Store reference to object */
      source = rv;
      /* and store the actual sink callback in the object */
      setPerlObjectAttr( RETVAL, "_source", newRV_inc( SvRV(sourcefunc) ));
    }

  }

  /* Need to use astChannelFor style interface so that we can register
     a fixed callback and a reference to a CV */
  if ( strstr( class, "Channel") != NULL) {
   ASTCALL(
    channel = astChannelFor( (const char *(*)()) source, sourceWrap,
                             (void (*)( const char * )) sink, sinkWrap, options );
   )
   if (astOK) setPerlAstObject( RETVAL, (AstObject*)channel );
  } else if (strstr( class, "FitsChan") != NULL) {
   ASTCALL(
    fitschan = astFitsChanFor( (const char *(*)()) source, sourceWrap,
                             (void (*)( const char * )) sink, sinkWrap, options );
   )
   if (astOK) setPerlAstObject( RETVAL, (AstObject*)fitschan );
  } else if (strstr( class, "XmlChan") != NULL ) {
#ifndef HASXMLCHAN
   Perl_croak(aTHX_ "XmlChan: Please upgrade to AST V3.1 or greater");
#else
   ASTCALL(
    xmlchan = astXmlChanFor( (const char *(*)()) source, sourceWrap,
                             (void (*)( const char * )) sink, sinkWrap, options );
   )
   if (astOK) setPerlAstObject( RETVAL, (AstObject*)xmlchan );
#endif
  } else if (strstr( class, "StcsChan") != NULL ) {
#ifndef HASSTCSCHAN
   Perl_croak(aTHX_ "StcsChan: Please upgrade to AST V5.2 or greater");
#else
   ASTCALL(
    stcschan = astStcsChanFor( (const char *(*)()) source, sourceWrap,
                               (void (*)( const char * )) sink, sinkWrap, options );
   )
   if (astOK) setPerlAstObject( RETVAL, (AstObject*)stcschan );
#endif
  } else {
     Perl_croak(aTHX_ "Channel of class %s not recognized.", class );
  }
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL


MODULE = Starlink::AST  PACKAGE = Starlink::AST::GrismMap

AstGrismMap *
new( class, options )
  char * class
  char * options
 CODE:
#ifndef HASGRISMMAP
   Perl_croak(aTHX_ "GrismMap: Please upgrade to AST V3.x or greater");
#else
  ASTCALL(
   RETVAL = astGrismMap( options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::IntraMap

AstIntraMap *
new( class, name, nin, nout, options )
  char * class
  char * name
  int nin
  int nout
  char * options
 CODE:
  ASTCALL(
   RETVAL = astIntraMap( name, nin, nout, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::LutMap

AstLutMap *
new( class, lut, start, inc, options )
  char * class
  AV* lut
  double start
  double inc
  char * options
 PREINIT:
  int nlut;
  double * clut;
 CODE:
  nlut = av_len( lut ) + 1;
  clut = pack1D( newRV_noinc((SV*)lut), 'd' );
  ASTCALL(
   RETVAL = astLutMap( nlut, clut, start, inc, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::MathMap

AstMathMap *
new( class, nin, nout, fwd, inv, options )
  char * class
  int nin
  int nout
  AV* fwd
  AV* inv
  char * options
 PREINIT:
  int nfwd;
  int ninv;
  SV** elem;
  int i;
  char ** cfwd;
  char ** cinv;
 CODE:
  nfwd = av_len( fwd ) + 1;
  ninv = av_len( inv ) + 1;
  cfwd = pack1Dchar( fwd );
  cinv = pack1Dchar( inv );
  RETVAL = astMathMap( nin, nout, nfwd, (const char **)cfwd,
                       ninv, (const char**)cinv, options );
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST  PACKAGE = Starlink::AST::MatrixMap

# Note that form is derived from the size of matrix

AstMatrixMap *
new( class, nin, nout, matrix, options )
  char * class
  int nin
  int nout
  AV* matrix
  char * options
 PREINIT:
  int len;
  int form;
  double * cmatrix;
 CODE:
  len = av_len( matrix ) + 1;
  /* determine form from number of elements */
  if (len == 0) {
    form = 2;
  } else if (len == nin || len == nout ) {
    form = 1;
  } else if ( len == (nin * nout ) ) {
    form = 0;
  } else {
    Perl_croak(aTHX_ "MatrixMap: matrix len not consistent with nout/nin");
  }
  cmatrix = pack1D(newRV_noinc((SV*)matrix), 'd');
  ASTCALL(
   RETVAL = astMatrixMap( nin, nout, form, cmatrix, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Plot

AstPlot *
_new( class, frame, graphbox, basebox, options )
  char * class
  AstFrame * frame
  AV* graphbox
  AV* basebox
  char * options
 PREINIT:
  int len;
  float * cgraphbox;
  double * cbasebox;
 CODE:
  len = av_len( graphbox ) + 1;
  if ( len != 4 ) Perl_croak(aTHX_ "GraphBox must contain 4 values" );
  len = av_len( basebox ) + 1;
  if ( len != 4 ) Perl_croak(aTHX_ "BaseBox must contain 4 values" );
  cbasebox = pack1D( newRV_noinc((SV*)basebox), 'd');
  cgraphbox = pack1D( newRV_noinc((SV*)graphbox), 'f');
  ASTCALL(
    RETVAL = astPlot( frame, cgraphbox, cbasebox, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::PcdMap

AstPcdMap *
new( class, disco, pcdcen, options )
  char * class
  double disco
  AV* pcdcen
  char * options
 PREINIT:
  int len;
  double * cpcdcen;
 CODE:
  len = av_len( pcdcen ) + 1;
  if (len != 2 ) {
    Perl_croak(aTHX_ "Must supply two values to PcdCen");
  }
  cpcdcen = pack1D(newRV_noinc((SV*)pcdcen), 'd');
  ASTCALL(
   RETVAL = astPcdMap( disco, cpcdcen, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::PermMap

AstPermMap *
new( class, inperm, outperm, constant, options )
  char * class
  AV* inperm
  AV* outperm
  AV* constant
  char * options
 PREINIT:
  int len;
  int * coutperm;
  int * cinperm;
  double * cconstant;
  int nin;
  int nout;
 CODE:
  nin = av_len( inperm ) + 1;
  if (nin == 0 ) {
    /* no values */
    cinperm = NULL;
  } else {
    cinperm = pack1D(newRV_noinc((SV*)inperm), 'i' );
  }
  nout = av_len( outperm ) + 1;
  if (nout == 0 ) {
    /* no values */
    coutperm = NULL;
  } else {
    coutperm = pack1D(newRV_noinc((SV*)outperm), 'i' );
  }
  len = av_len( constant ) + 1;
  if (len == 0 ) {
    /* no values */
    cconstant = NULL;
  } else {
    cconstant = pack1D(newRV_noinc((SV*)constant), 'd' );
  }
  ASTCALL(
   RETVAL = astPermMap(nin, cinperm, nout, coutperm, cconstant, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::PolyMap

AstPolyMap *
new( class )
 CODE:
#ifndef HASPOLYMAP
   Perl_croak(aTHX_ "PolyMap: Please upgrade to AST V3.x or greater");
#else
  Perl_croak(aTHX_ "PolyMap not yet implemented");
#endif

MODULE = Starlink::AST   PACKAGE = Starlink::AST::ShiftMap

AstShiftMap *
new( class, shift, options )
  char * class
  AV* shift
  char * options
 PREINIT:
  int ncoord;
  double * cshift;
 CODE:
#ifndef HASSHIFTMAP
   Perl_croak(aTHX_ "ShiftMap: Please upgrade to AST V3.x or greater");
#else
  ncoord = av_len( shift ) + 1;
  cshift = pack1D(newRV_noinc((SV*)shift), 'd');
  ASTCALL(
   RETVAL = astShiftMap( ncoord, cshift, options);
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SkyFrame

AstSkyFrame *
new( class, options )
  char * class
  char * options
 CODE:
  ASTCALL(
   RETVAL = astSkyFrame( options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SpecFrame

AstSpecFrame *
new( class, options )
  char * class
  char * options
 CODE:
#ifndef HASSPECFRAME
   Perl_croak(aTHX_ "SpecFrame: Please upgrade to AST V2.x or greater");
#else
  ASTCALL(
   RETVAL = astSpecFrame( options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::DSBSpecFrame

AstDSBSpecFrame *
new( class, options )
  char * class
  char * options
 CODE:
#ifndef HASDSBSPECFRAME
   Perl_croak(aTHX_ "DSBSpecFrame: Please upgrade to AST V3.4 or greater");
#else
  ASTCALL(
   RETVAL = astDSBSpecFrame( options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::TimeFrame

AstTimeFrame *
new( class, options )
  char * class
  char * options
 CODE:
#ifndef HASTIMEFRAME
   Perl_croak(aTHX_ "TimeFrame: Please upgrade to AST V3.7 or greater");
#else
  ASTCALL(
   RETVAL = astTimeFrame( options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SlaMap

AstSlaMap *
new( class, flags, options )
  char * class
  int flags
  char * options
 CODE:
  ASTCALL(
   RETVAL = astSlaMap( flags, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SphMap

AstSphMap *
new( class, options )
  char * class
  char * options
 CODE:
  ASTCALL(
   RETVAL = astSphMap( options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SpecMap

AstSpecMap *
new( class, nin, flags, options )
  char * class
  int nin
  int flags
  char * options
 CODE:
#ifndef HASSPECMAP
   Perl_croak(aTHX_ "SpecMap: Please upgrade to AST V2.x or greater");
#else
  ASTCALL(
   RETVAL = astSpecMap( nin, flags, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::TimeMap

AstTimeMap *
new( flags, options )
  int flags
  char * options
 CODE:
#ifndef HASTIMEMAP
   Perl_croak(aTHX_ "TimeMap: Please upgrade to AST V3.7 or greater");
#else
  ASTCALL(
   RETVAL = astTimeMap( flags, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::TranMap

AstTranMap *
new( class, map1, map2, options )
  char * class
  AstMapping * map1
  AstMapping * map2
  char * options
 CODE:
#ifndef HASTRANMAP
   Perl_croak(aTHX_ "TranMap: Please upgrade to AST V3.2 or greater");
#else
  ASTCALL(
   RETVAL = astTranMap( map1, map2, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::UnitMap

AstUnitMap *
new( class, ncoord, options )
  char * class
  int ncoord
  char * options
 CODE:
  ASTCALL(
   RETVAL = astUnitMap( ncoord, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::WcsMap

AstWcsMap *
new( class, ncoord, type, lonax, latax, options )
  char * class
  int ncoord
  WcsMapType type
  int lonax
  int latax
  char * options
 CODE:
  ASTCALL(
   RETVAL = astWcsMap( ncoord, type, lonax, latax,options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::WinMap

# we derive ncoord from the input array dimensions

AstWinMap *
new( class, ina, inb, outa, outb, options )
  char * class
  AV* ina
  AV* inb
  AV* outa
  AV* outb
  char * options
 CODE:
  /* minimal arg checking - lazy XXXX */
  RETVAL = astWinMap( av_len(ina)+1, pack1D(newRV_noinc((SV*)ina),'d'),
                      pack1D(newRV_noinc((SV*)inb),'d'),
                      pack1D(newRV_noinc((SV*)outa),'d'),
                      pack1D(newRV_noinc((SV*)outb),'d'),options );
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::ZoomMap

AstZoomMap *
new( class, ncoord, zoom, options )
  char * class
  int ncoord
  double zoom
  char * options
 CODE:
  ASTCALL(
   RETVAL = astZoomMap( ncoord, zoom, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL


MODULE = Starlink::AST   PACKAGE = Starlink::AST PREFIX = ast

void
astClear( this, attrib )
  AstObject * this
  char * attrib
 CODE:
  ASTCALL(
    astClear( this, attrib );
  )

# Store flag in the object when annulled so that the object destructor
# does not cause a second annul.

void
astAnnul( this )
  AstObject * this
 PREINIT:
  SV* arg = ST(0);
 CODE:
  ASTCALL(
   this = astAnnul( this );
  )
  setPerlObjectAttr( arg, "_annul",newSViv(1));


AstObject *
ast_Clone( this )
  AstObject * this
 CODE:
  ASTCALL(
   RETVAL = astClone( this );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

AstObject *
ast_Copy( this )
  AstObject * this
 CODE:
  ASTCALL(
   RETVAL = astCopy( this );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

# Note that we do not return a NULL object

void
astDelete( this )
  AstObject * this
 CODE:
  ASTCALL(
   this = astDelete( this );
  )

void
astExempt( this )
  AstObject * this
 CODE:
  ASTCALL(
   astExempt( this );
  )

void
astExport( this )
  AstObject * this
 CODE:
  ASTCALL(
   astExport( this );
  )

int
astHasAttribute( this, attrib )
  AstObject * this
  char * attrib
 CODE:
#ifndef HASHASATTRIBUTE
   Perl_croak(aTHX_ "astHasAttribute: Please upgrade to AST V5.3 or newer");
#else
  ASTCALL(
   RETVAL = astHasAttribute( this, attrib );
  )
#endif
 OUTPUT:
  RETVAL

const char *
astGetC( this, attrib )
  AstObject * this
  char * attrib
 PREINIT:
  SV * arg = ST(0);
 CODE:
  if (astIsAPlot(this)) {
     PLOTCALL( arg,
        RETVAL = astGetC( this, attrib );
     )
  } else {
    ASTCALL(
     RETVAL = astGetC( this, attrib );
    )
  }
 OUTPUT:
  RETVAL

# Float is just an alias for double

double
astGetD( this, attrib )
  AstObject * this
  char * attrib
 ALIAS:
  astGetF = 1
 PREINIT:
  SV * arg = ST(0);
 CODE:
  if (astIsAPlot(this)) {
     PLOTCALL( arg,
        RETVAL = astGetD( this, attrib );
     )
  } else {
    ASTCALL(
     RETVAL = astGetD( this, attrib );
    )
  }
 OUTPUT:
  RETVAL

int
astGetI( this, attrib )
  AstObject * this
  char * attrib
 ALIAS:
  astGetL = 1
 PREINIT:
  SV * arg = ST(0);
 CODE:
  if (astIsAPlot(this)) {
     PLOTCALL( arg,
        RETVAL = astGetI( this, attrib );
     )
  } else {
    ASTCALL(
     RETVAL = astGetI( this, attrib );
    )
  }
 OUTPUT:
  RETVAL

# Need to decide later whether the astIsA functions need to be
# implemented since Perl can do that - XXXX


# sprintf behaviour is left to the enclosing perl layer

void
ast_Set(this, settings )
  AstObject * this
  char * settings
 CODE:
  ASTCALL(
   astSet(this, settings );
  )

void
astSetC( this, attrib, value )
  AstObject * this
  char * attrib
  char * value
 CODE:
  ASTCALL(
   astSetC( this, attrib, value );
  )

# Float is just an alias for double

void
astSetD( this, attrib, value )
  AstObject * this
  char * attrib
  double value
 ALIAS:
  astSetF = 1
 CODE:
  ASTCALL(
   astSetD( this, attrib, value );
  )


void
astSetI( this, attrib, value )
  AstObject * this
  char * attrib
  int value
 ALIAS:
  astSetL = 1
 CODE:
  ASTCALL(
   astSetI( this, attrib, value );
  )

void
astShow( this )
  AstObject * this
 CODE:
  ASTCALL(
   astShow( this );
  )

bool
astTest( this, attrib )
  AstObject * this
  char * attrib
 CODE:
  ASTCALL(
   RETVAL = astTest( this, attrib );
  )
 OUTPUT:
  RETVAL

# Use annul as automatic destructor
# For automatic destructor we do not want to throw an exception
# on error. So do not use ASTCALL. Do a manual printf to stderr and continue.
# Does nothing if a key _annul is present in the object and is true.
# This condition is usually met if the user has manually called the Annull
# method on the object.

void
astDESTROY( obj )
  SV * obj
 PREINIT:
  int my_xsstatus_val = 0;
  int *my_xsstatus = &my_xsstatus_val;
  int *old_ast_status;
  int i;
  SV ** elem;
  SV * flag;
  char one[3] = "! ";
  char two[3] = "!!";
  char * pling;
  AV* local_err;
  char * s = CopFILE( PL_curcop );
  STRLEN msglen;
  IV mytmp;
  AstObject * this;
 CODE:
  /* see if we have annulled already */
  flag = getPerlObjectAttr( obj, "_annul");
  if (flag == NULL || ! SvTRUE(flag) ) {
    /* DESTROY always seems to insert stub code for SVREF not what is in  */
    /* the typemap file. Do it manually */
    mytmp = extractAstIntPointer( obj );
    this = INT2PTR( AstObject *, mytmp );

    MUTEX_LOCK(&AST_mutex);
    My_astClearErrMsg();
    old_ast_status = astWatch( my_xsstatus );
    this = astAnnul( this );
    astWatch( old_ast_status );
    My_astCopyErrMsg( &local_err, *my_xsstatus );
    MUTEX_UNLOCK(&AST_mutex);
    if (*my_xsstatus != 0 ) {
      for (i=0; i <= av_len( local_err ); i++ ) {
        pling = ( i == 0 ? two : one );
        elem = av_fetch( local_err, i, 0 );
        if (elem != NULL ) {
          PerlIO_printf( PerlIO_stderr(),  "%s %s\n", pling,
		         SvPV( *elem, msglen ));
        }
      }
      if (!s) s = "(none)";
      PerlIO_printf( PerlIO_stderr(),
                     "!  (in cleanup from file %s:%" IVdf ")\n",
                     s, (IV) CopLINE(PL_curcop));
    }
  }

MODULE = Starlink::AST   PACKAGE = Starlink::AST::KeyMap

int
AST__BADTYPE()
 CODE:
#ifdef AST__BADTYPE
    RETVAL = AST__BADTYPE;
#else
    Perl_croak(aTHX_ "Constant AST__BADTYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__INTTYPE()
 CODE:
#ifdef AST__INTTYPE
    RETVAL = AST__INTTYPE;
#else
    Perl_croak(aTHX_ "Constant AST__INTTYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__SINTTYPE()
 CODE:
#ifdef AST__SINTTYPE
    RETVAL = AST__SINTTYPE;
#else
    Perl_croak(aTHX_ "Constant AST__SINTTYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__DOUBLETYPE()
 CODE:
#ifdef AST__DOUBLETYPE
    RETVAL = AST__DOUBLETYPE;
#else
    Perl_croak(aTHX_ "Constant AST__DOUBLETYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__FLOATTYPE()
 CODE:
#ifdef AST__FLOATTYPE
    RETVAL = AST__DOUBLETYPE;
#else
    Perl_croak(aTHX_ "Constant AST__FLOATTYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__STRINGTYPE()
 CODE:
#ifdef AST__STRINGTYPE
    RETVAL = AST__STRINGTYPE;
#else
    Perl_croak(aTHX_ "Constant AST__STRINGTYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__OBJECTTYPE()
 CODE:
#ifdef AST__OBJECTTYPE
    RETVAL = AST__OBJECTTYPE;
#else
    Perl_croak(aTHX_ "Constant AST__OBJECTTYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__UNDEFTYPE()
 CODE:
#ifdef AST__UNDEFTYPE
    RETVAL = AST__UNDEFTYPE;
#else
    Perl_croak(aTHX_ "Constant AST__UNDEFTYPE not defined\n");
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::KeyMap PREFIX = ast

AstKeyMap *
new( class, options )
  char * class
  char * options
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "AstKeyMap: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   RETVAL = astKeyMap( options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

void
astMapPutU( this, key, comment )
  AstKeyMap * this
  char * key
  char * comment
 CODE:
#ifndef HASMAPPUTU
  Perl_croak(aTHX_ "astMapPutU: Please upgrade to AST V5.3 or newer");
#else
  ASTCALL(
   astMapPutU( this, key, comment);
  )
#endif

void
astMapPut0D( this, key, value, comment)
  AstKeyMap * this
  char * key
  double value
  char * comment
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut0D: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   astMapPut0D( this, key, value, comment);
  )
#endif

void
astMapPut0I( this, key, value, comment)
  AstKeyMap * this
  char * key
  int value
  char * comment
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut0I: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   astMapPut0I( this, key, value, comment);
  )
#endif

void
astMapPut0S( this, key, value, comment)
  AstKeyMap * this
  char * key
  int value
  char * comment
 CODE:
#ifndef HASKEYMAPSHORT
  Perl_croak(aTHX_ "astMapPut0S: Please upgrade to AST V5.4 or newer");
#else
  if ( value < SHRT_MIN || value > SHRT_MAX ) {
    Perl_croak( aTHX_ "astMapPut0S: Supplied short value (%d) is out of range",
                value );
  }
  ASTCALL(
   astMapPut0S( this, key, value, comment);
  )
#endif

void
astMapPut0C( this, key, value, comment)
  AstKeyMap * this
  char * key
  char * value
  char * comment
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut0C: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   astMapPut0C( this, key, value, comment);
  )
#endif

void
astMapPut0A( this, key, value, comment)
  AstKeyMap * this
  char * key
  AstObject * value
  char * comment
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut0A: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   astMapPut0A( this, key, value, comment);
  )
#endif

void
astMapPut1D( this, key, values, comment)
  AstKeyMap * this
  char * key
  AV * values
  char * comment
 PREINIT:
  int size;
  double * val;
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut1D: Please upgrade to AST V3.5 or newer");
#else
  size = av_len(values) + 1;
  val = pack1D( newRV_noinc((SV*)values),'d');
  ASTCALL(
   astMapPut1D( this, key, size, val, comment);
  )
#endif

void
astMapPut1I( this, key, values, comment)
  AstKeyMap * this
  char * key
  AV * values
  char * comment
 PREINIT:
  int size;
  int * val;
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut1I: Please upgrade to AST V3.5 or newer");
#else
  size = av_len(values) + 1;
  val = pack1D( newRV_noinc((SV*)values),'i');
  ASTCALL(
   astMapPut1I( this, key, size, val, comment);
  )
#endif

void
astMapPut1S( this, key, values, comment)
  AstKeyMap * this
  char * key
  AV * values
  char * comment
 PREINIT:
  int size;
  int i;
  short * val;
 CODE:
#ifndef HASKEYMAPSHORT
  Perl_croak(aTHX_ "astMapPut1S: Please upgrade to AST V5.4 or newer");
#else
  size = av_len(values) + 1;
  for (i=0; i<size;i++) {
     SV ** element = av_fetch( values, i, 0 );
     if (element) {
        IV ival = 0;
        if (SvROK(*element)) {
          Perl_croak( aTHX_ "Can not store reference in short keymap" );
        }
        ival = SvIV(*element);
        if (ival < SHRT_MIN || ival > SHRT_MAX) {
          Perl_croak( aTHX_ "MapPut1S: Value of element %d (%ld) is out of range for a short",
                      i, (long)ival );
        }
     }
  }
  val = pack1D( newRV_noinc((SV*)values),'s');
  ASTCALL(
   astMapPut1S( this, key, size, val, comment);
  )
#endif

void
astMapPut1C( this, key, values, comment)
  AstKeyMap * this
  char * key
  AV * values
  char * comment
 PREINIT:
  int size;
  char ** val;
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut1C: Please upgrade to AST V3.5 or newer");
#else
  size = av_len(values) + 1;
  val = pack1Dchar( values );
  ASTCALL(
   astMapPut1C( this, key, size, (const char **)val, comment);
  )
#endif

void
astMapPut1A( this, key, values, comment)
  AstKeyMap * this
  char * key
  AV * values
  char * comment
 PREINIT:
  int size;
  AstObject ** val;
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapPut1A: Please upgrade to AST V3.5 or newer");
#else
  size = av_len(values) + 1;
  val = pack1DAstObj( values );
  ASTCALL(
   astMapPut1A( this, key, size, val, comment);
  )
#endif

void
astMapGet0D( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  double RETVAL;
  int status;
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet0D: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
    status = astMapGet0D( this, key, &RETVAL );
  )
  if (status != 0) {
    XPUSHs(sv_2mortal(newSVnv(RETVAL)));
  } else {
    XSRETURN_EMPTY;
  }
#endif

# Short ints are handled by "I" interface because Perl will always
# convert the short to an IV.

void
astMapGet0I( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  int RETVAL;
  int status;
 ALIAS:
   MapGet0S = 1
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet0I: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
    status = astMapGet0I( this, key, &RETVAL );
  )
  if (status != 0) {
    XPUSHs(sv_2mortal(newSViv(RETVAL)));
  } else {
    XSRETURN_EMPTY;
  }
#endif

void
astMapGet0C( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  char * RETVAL;
  int status;
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet0C: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
    status = astMapGet0C( this, key, (const char **)&RETVAL );
  )
  if (status != 0) {
    XPUSHs(sv_2mortal(newSVpvn(RETVAL,strlen(RETVAL))));
  } else {
    XSRETURN_EMPTY;
  }
#endif

# Note the underscore in the name because currently we return
# a Starlink::AST object rather than a real object and there is
# a perl layer to rebless. We should probably do this in the C
# layer

void
ast_MapGet0A( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  AstObject * RETVAL;
  int status;
  SV * sv;
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet0A: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
    status = astMapGet0A( this, key, &RETVAL );
  )
  if (status != 0) {
    /* Have an AstObject pointer. Convert to object. */
    sv = createPerlObject( "AstObjectPtr", RETVAL );
    XPUSHs(sv_2mortal( sv ));
  } else {
    XSRETURN_EMPTY;
  }
#endif


void
astMapGet1D( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  int i;
  int status;
  double * outarr;
  int nelems;
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet1D: Please upgrade to AST V3.5 or newer");
#else
  /* First we need to find out how many elements are in the KeyMap */
  nelems = astMapLength( this, key );
  if (nelems == 0) {
    XSRETURN_EMPTY;
  }

  /* get some memory */
  outarr = get_mortalspace( nelems, 'd' );

  ASTCALL(
    status = astMapGet1D( this, key, nelems, &nelems, outarr );
  )
  if (status != 0) {
    for (i=0; i < nelems; i++) {
      XPUSHs(sv_2mortal(newSVnv( outarr[i] )));
    }
  } else {
    XSRETURN_EMPTY;
  }
#endif

# The short int version does not need a separate implementation
# because perl doesn't care and will end up reading it in as an IV
# anyhow. The only reason to implement the "S" routine separately
# is for the smaller memory requirement.

void
astMapGet1I( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  int i;
  int status;
  int * outarr;
  int nelems;
 ALIAS:
  MapGet1S = 1
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet1I: Please upgrade to AST V3.5 or newer");
#else
  /* First we need to find out how many elements are in the KeyMap */
  nelems = astMapLength( this, key );
  if (nelems == 0) {
    XSRETURN_EMPTY;
  }

  /* get some memory */
  outarr = get_mortalspace( nelems, 'i' );

  ASTCALL(
    status = astMapGet1I( this, key, nelems, &nelems, outarr );
  )
  if (status != 0) {
    for (i=0; i < nelems; i++) {
      XPUSHs(sv_2mortal(newSViv( outarr[i] )));
    }
  } else {
    XSRETURN_EMPTY;
  }
#endif

void
ast_MapGet1A( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  SV * sv;
  int i;
  int status;
  AstObject ** outarr;
  int nelems;
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet1A: Please upgrade to AST V3.5 or newer");
#else
  /* First we need to find out how many elements are in the KeyMap */
  nelems = astMapLength( this, key );
  if (nelems == 0) {
    XSRETURN_EMPTY;
  }

  /* get some memory */
  outarr = get_mortalspace( nelems, 'v' );

  ASTCALL(
    status = astMapGet1A( this, key, nelems, &nelems, outarr );
  )
  if (status != 0) {
    for (i=0; i < nelems; i++) {
      /* Have an AstObject pointer. Convert to object. */
      sv = createPerlObject( "AstObjectPtr", outarr[i] );
      XPUSHs(sv_2mortal( sv ));
    }
  } else {
    XSRETURN_EMPTY;
  }
#endif

void
astMapGet1C( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  SV * sv;
  int i;
  int status;
  char * buffer;
  char * tmpp;
  int nelems;
  int maxlen = 80; /* max length of each string in map. Includes NUL */
 PPCODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapGet1C: Please upgrade to AST V3.5 or newer");
#else
  /* First we need to find out how many elements are in the KeyMap */
  nelems = astMapLength( this, key );
  if (nelems == 0) {
    XSRETURN_EMPTY;
  }

  /* get some memory */
  buffer = get_mortalspace( nelems * maxlen, 'u' );

  ASTCALL(
    status = astMapGet1C( this, key, maxlen, nelems, &nelems, buffer );
  )
  if (status != 0) {
    /* set temp pointer to start of buffer */
    tmpp = buffer;
    for (i=0; i < nelems; i++) {
      /* Jump through the buffer in maxlen hops */
      XPUSHs(sv_2mortal( newSVpvn(tmpp, strlen(tmpp)) ));
      tmpp += maxlen;
    }
  } else {
    XSRETURN_EMPTY;
  }
#endif

void
astMapRemove( this, key )
  AstKeyMap * this
  char * key
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapRemove: Please upgrade to AST V3.5 or newer");
#else

  ASTCALL(
    astMapRemove( this, key );
  )
#endif

int
astMapSize( this )
  AstKeyMap * this
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapSize: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   RETVAL = astMapSize( this );
  )
#endif
 OUTPUT:
  RETVAL

int
astMapLength( this, key )
  AstKeyMap * this
  char * key
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapLength: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   RETVAL = astMapLength( this, key );
  )
#endif
 OUTPUT:
  RETVAL

bool
astMapHasKey( this, key )
  AstKeyMap * this
  char * key
 PREINIT:
  int haskey;
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapHasKey: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
    haskey = astMapHasKey( this, key );
  )
  RETVAL = ( haskey == 0 ? 0 : 1 );
#endif
 OUTPUT:
  RETVAL

const char *
astMapKey( this, index )
  AstKeyMap * this
  int index
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapKey: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
    RETVAL = astMapKey( this, index );
  )
#endif
 OUTPUT:
  RETVAL

int
astMapType( this, key )
  AstKeyMap * this
  char * key
 CODE:
#ifndef HASKEYMAP
  Perl_croak(aTHX_ "astMapType: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
   RETVAL = astMapType( this, key );
  )
#endif
 OUTPUT:
  RETVAL

bool
astMapDefined( this, key )
  AstKeyMap * this
  char * key
 CODE:
#ifndef HASMAPDEFINED
  Perl_croak(aTHX_ "astMapDefined: Please upgrade to AST V7.2 or newer");
#else
  ASTCALL(
   RETVAL = astMapDefined( this, key );
  )
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Frame PREFIX = ast


double
astAngle( this, a, b, c )
  AstFrame * this
  AV* a
  AV* b
  AV* c
 PREINIT:
  double * aa;
  double * bb;
  double * cc;
  int naxes;
 CODE:
  /* Create C arrays of the correct dimensions */
  naxes = astGetI( this, "Naxes" );

  /* Copy from the perl array to the C array */
  if (av_len(a) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in first coord array must be %d",
                naxes);
  if (av_len(b) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in second coord array must be %d",
                naxes);
  if (av_len(c) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in third coord array must be %d",
                naxes);

  aa = pack1D( newRV_noinc((SV*)a), 'd');
  bb = pack1D( newRV_noinc((SV*)b), 'd');
  cc = pack1D( newRV_noinc((SV*)c), 'd');

  /* Call the ast function */
  ASTCALL(
   RETVAL = astAngle( this, aa, bb, cc);
  )
 OUTPUT:
  RETVAL

double
astAxAngle( this, a, b, axis )
  AstFrame * this
  AV* a
  AV* b
  int axis
 PREINIT:
  double * aa;
  double * bb;
  int naxes;
 CODE:
  /* Create C arrays of the correct dimensions */
  naxes = astGetI( this, "Naxes" );

  /* Copy from the perl array to the C array */
  if (av_len(a) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in first coord array must be %d",
                naxes);
  if (av_len(b) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in second coord array must be %d",
                naxes);

  aa = pack1D( newRV_noinc((SV*)a), 'd');
  bb = pack1D( newRV_noinc((SV*)b), 'd');
  ASTCALL(
   RETVAL = astAxAngle( this, aa, bb, axis);
  )
 OUTPUT:
  RETVAL

double
astAxDistance( this, axis, v1, v2)
  AstFrame * this
  int axis
  double v1
  double v2
 CODE:
  ASTCALL(
   RETVAL = astAxDistance( this, axis, v1, v2);
  )
 OUTPUT:
  RETVAL

double
astAxOffset( this, axis, v1, dist)
  AstFrame * this
  int axis
  double v1
  double dist
 CODE:
  ASTCALL(
   RETVAL = astAxOffset( this, axis, v1, dist);
  )
 OUTPUT:
  RETVAL

AstFrameSet *
astConvert( from, to, domainlist )
  AstFrame * from
  AstFrame * to
  char * domainlist
 CODE:
  ASTCALL(
   RETVAL = astConvert( from, to, domainlist );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

double
astDistance( this, point1, point2 )
  AstFrame * this
  AV* point1
  AV* point2
 PREINIT:
  double * aa;
  double * bb;
  int naxes;
 CODE:
  /* Create C arrays of the correct dimensions */
  naxes = astGetI( this, "Naxes" );

  /* Copy from the perl array to the C array */
  if (av_len(point1) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in first coord array must be %d",
                naxes);
  if (av_len(point2) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in second coord array must be %d",
                naxes);

  aa = pack1D( newRV_noinc((SV*)point1), 'd');
  bb = pack1D( newRV_noinc((SV*)point2), 'd');
  ASTCALL(
   RETVAL = astDistance( this, aa, bb);
  )
 OUTPUT:
  RETVAL

AstFrameSet *
astFindFrame( this, template, domainlist )
  AstFrame * this
  AstFrame * template
  char * domainlist
 CODE:
  ASTCALL(
   RETVAL = astFindFrame( this, template, domainlist );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

const char *
astFormat( this, axis, value )
  AstFrame * this
  int axis
  double value
 CODE:
  ASTCALL(
   RETVAL = astFormat( this, axis, value );
  )
 OUTPUT:
  RETVAL

int
astGetActiveUnit( this )
  AstFrame * this
 CODE:
#ifndef HASGETACTIVEUNIT
  Perl_croak(aTHX_ "astGetActiveUnit: Please upgrade to AST V2.x or newer");
#else
  ASTCALL(
   RETVAL = astGetActiveUnit( this );
  )
#endif
 OUTPUT:
  RETVAL

# @normalised = $wcs->Norm( @unnormalised );

void
astNorm( this, ... )
  AstFrame * this
 PREINIT:
  int argoff = 1; /* number of fixed arguments */
  int naxes;
  double * aa;
  int i;
  int ncoord_in;
  double * inputs;
 PPCODE:
  /* Create C arrays of the correct dimensions */
  naxes = astGetI( this, "Naxes" );
  ncoord_in = items - argoff;

  /* Copy from the perl array to the C array */
  if (naxes != ncoord_in )
     Perl_croak(aTHX_ "Number of elements in first coord array must be %d",
                naxes);
  aa = get_mortalspace( ncoord_in, 'd' );
  for (i=0; i<ncoord_in; i++) {
     int argpos = i + argoff;
     aa[i] = SvNV( ST(argpos) );
  }

  ASTCALL(
   astNorm( this, aa );
  )

  for (i=0; i<naxes; i++) {
    XPUSHs( sv_2mortal( newSVnv( aa[i] ) ) );
  }

# Return list

void
astOffset( this, point1, point2, offset )
  AstFrame * this
  AV* point1
  AV* point2
  double offset
 PREINIT:
  int naxes;
  double * aa;
  double * bb;
  double * point3;
  int i;
  AV * myoffset;
 PPCODE:
  naxes = astGetI( this, "Naxes" );

  /* Copy from the perl array to the C array */
  if (av_len(point1) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in first coord array must be %d",
                naxes);
  aa = pack1D( newRV_noinc((SV*)point1), 'd');
  if (av_len(point2) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in second coord array must be %d",
                naxes);
  bb = pack1D( newRV_noinc((SV*)point2), 'd');


  /* Somewhere to put the return values */
  point3 = get_mortalspace( naxes, 'd' );

  ASTCALL(
   astOffset( this, aa, bb, offset, point3 );
  )

  /* now need to push the resulting values onto the return stack */
  /* Put everything in an array [rather than the stack] in order to
     be consistent in returning C arrays as perl arrays. */
  myoffset = newAV();
  for (i =0; i < naxes; i++ ) {
    av_push( myoffset, newSVnv( point3[i] ));
  }
  XPUSHs( newRV_noinc( (SV*)myoffset ));


# Returns angle and reference to array of pair of coordinates

void
astOffset2( this, point1, angle, offset )
  AstFrame * this
  AV* point1
  double angle
  double offset
 PREINIT:
  int naxes;
  double * aa;
  double * point2;
  int i;
  double RETVAL;
  AV * myoffset;
 PPCODE:
  naxes = astGetI( this, "Naxes" );

  /* Copy from the perl array to the C array */
  if (av_len(point1) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in first coord array must be %d",
                naxes);
  aa = pack1D( newRV_noinc((SV*)point1), 'd');

  /* Somewhere to put the return values */
  point2 = get_mortalspace( naxes, 'd' );

  ASTCALL(
   RETVAL = astOffset2( this, aa, angle, offset, point2 );
  )

  /* Push the angle on to the stack */
  XPUSHs(sv_2mortal(newSVnv(RETVAL)));

  /* Put everything in an array [rather than the stack] in order to
     be consistent in returning C arrays as perl arrays. */
  myoffset = newAV();
  for (i =0; i < naxes; i++ ) {
    av_push( myoffset, newSVnv( point2[i] ));
  }
  XPUSHs( newRV_noinc( (SV*)myoffset ));


void
astPermAxes( this, perm )
  AstFrame * this
  AV* perm
 PREINIT:
  int * aa;
  int naxes;
 CODE:
  naxes = astGetI(this, "Naxes");
  /* Copy from the perl array to the C array */
  if (av_len(perm) != naxes-1)
     Perl_croak(aTHX_ "Number of elements in perm array must be %d",
                naxes);
  aa = pack1D( newRV_noinc((SV*)perm), 'i');
  ASTCALL(
   astPermAxes( this, aa );
  )

# Returns a new frame and an optional mapping
# Also note that we count axes ourselves

# We always ask for the return mapping and we always
# return both the new frame and the mapping from the old
# The perl side decides whether the user wants to keep the
# mapping or not depending on context (Which is unavailable
# to XS)

void
ast_PickAxes( this, axes )
  AstFrame * this;
  AV* axes
 PREINIT:
  int maxaxes;
  int naxes;
  int * aa;
  AstMapping * map;
  AstFrame * newframe;
 PPCODE:
  maxaxes = astGetI(this, "Naxes");
  naxes = av_len(axes) + 1;
  if ( naxes > maxaxes )
    Perl_croak(aTHX_ "Number of axes selected must be less than number of axes in frame");
  aa = pack1D( newRV_noinc((SV*)axes), 'i');
  ASTCALL(
   newframe = astPickAxes( this, naxes, aa, &map);
  )
  if ( newframe == AST__NULL ) XSRETURN_UNDEF;
  /* Create perl objects from the two return arguments */
  XPUSHs(sv_2mortal( createPerlObject( "AstFramePtr", (AstObject*)newframe )));
  XPUSHs(sv_2mortal( createPerlObject( "AstMappingPtr", (AstObject*)map )));


# Returns reference to array [point4], plus two distances

void
astResolve( this, point1, point2, point3 )
  AstFrame * this
  AV* point1
  AV* point2
  AV* point3
 PREINIT:
  double * cpoint1;
  double * cpoint2;
  double * cpoint3;
  double * cpoint4;
  AV * point4;
  double d1;
  double d2;
  int len;
  int naxes;
 PPCODE:
  naxes = astGetI(this, "Naxes");
  len = av_len(point1) + 1;
  if ( naxes != len )
    Perl_croak(aTHX_ "Number of coords in point1 must be equal to the number of axes in frame [%d != %d]", naxes, len);
  len = av_len(point2) + 1;
  if ( naxes != len )
    Perl_croak(aTHX_ "Number of coords in point2 must be equal to the number of axes in frame [%d != %d]", naxes, len);
  len = av_len(point3) + 1;
  if ( naxes != len )
    Perl_croak(aTHX_ "Number of coords in point3 must be equal to the number of axes in frame [%d != %d]", naxes, len);

  cpoint1 = pack1D( newRV_noinc((SV*)point1), 'd');
  cpoint2 = pack1D( newRV_noinc((SV*)point2), 'd');
  cpoint3 = pack1D( newRV_noinc((SV*)point3), 'd');
  cpoint4 = get_mortalspace( naxes, 'd' );

  ASTCALL(
    astResolve(this, cpoint1, cpoint2, cpoint3, cpoint4, &d1, &d2);
  )

  point4 = newAV();
  unpack1D( newRV_noinc((SV*)point4), cpoint4, 'd', naxes);

  XPUSHs( newRV_noinc((SV*) point4));
  XPUSHs( sv_2mortal(newSVnv(d1)));
  XPUSHs( sv_2mortal(newSVnv(d2)));


void
astSetActiveUnit( this, value )
  AstFrame * this
  int value
 CODE:
#ifndef HASSETACTIVEUNIT
  Perl_croak(aTHX_ "astSetActiveUnit: Please upgrade to AST V2.x or newer");
#else
  ASTCALL(
   astSetActiveUnit( this, value );
  )
#endif

# astUnformat currently returns the value not the number of
# characters read. Returns undef if no character read
#  XXXXX

double
astUnformat( this, axis, string )
  AstFrame * this
  int axis
  char * string
 PREINIT:
  int nread;
 CODE:
  nread = astUnformat( this, axis, string, &RETVAL );
  if (nread == 0 ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL


MODULE = Starlink::AST   PACKAGE = Starlink::AST::FrameSet PREFIX = ast

void
astAddFrame( this, iframe, map, frame)
  AstFrameSet * this
  int iframe
  AstMapping * map
  AstFrame * frame
 CODE:
  ASTCALL(
   astAddFrame( this, iframe, map, frame );
  )


AstFrame *
ast_GetFrame( this, iframe )
  AstFrameSet * this
  int iframe
 CODE:
  ASTCALL(
   RETVAL = astGetFrame( this, iframe );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

AstMapping *
astGetMapping( this, iframe1, iframe2 )
  AstFrameSet * this
  int iframe1
  int iframe2
 CODE:
  ASTCALL(
   RETVAL = astGetMapping( this, iframe1, iframe2 );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

void
astRemapFrame( this, iframe, map )
  AstFrameSet * this
  int iframe
  AstMapping * map
 CODE:
  ASTCALL(
   astRemapFrame( this, iframe, map );
  )

void
astRemoveFrame( this, iframe )
  AstFrameSet * this
  int iframe
 CODE:
  ASTCALL(
   astRemoveFrame( this, iframe );
  )

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Mapping PREFIX = ast

# Return the new mappings and booleans as a list
# Do this later since it requires subversion of the typemap
# system

# XXXXX

void
astDecompose( this )
  AstMapping * this
 PREINIT:
  AstMapping * map1;
  AstMapping * map2;
  int series;
  int invert1;
  int invert2;
 PPCODE:
  Perl_croak(aTHX_ "astDecompose not yet implemented\n");
  /* May want to restrict this to CmpMap and CmpFrame classes
     explicitly */
  ASTCALL(
   astDecompose(this, &map1, &map2, &series, &invert1, &invert2);
  )


void
astInvert( this )
  AstMapping * this
 CODE:
  ASTCALL(
   astInvert( this );
  )

void
astLinearApprox( this, lbnd, ubnd, tol )
  AstMapping * this
  AV * lbnd
  AV * ubnd
  double tol
 PREINIT:
  int len;
  double * clbnd;
  double * cubnd;
  int nin;
  int nout;
  int ncoeff;
  double * fit;
  int i;
  int status;
 PPCODE:
#ifndef HASLINEARAPPROX
   Perl_croak(aTHX_ "astLinearApprox: Please upgrade to AST V3.4 or greater");
#else
  /* get the input values and verify them */
  nin = astGetI( this, "Nin" );
  len = av_len( lbnd ) + 1;
  if ( len != nin ) Perl_croak( aTHX_ "lbnd must contain %d elements", nin );
  len = av_len( ubnd ) + 1;
  if ( len != nin ) Perl_croak( aTHX_ "ubnd must contain %d elements", nin );
  clbnd = pack1D(newRV_noinc((SV*)lbnd), 'd');
  cubnd = pack1D(newRV_noinc((SV*)ubnd), 'd');

  /* Get memory for the return values */
  nout = astGetI( this, "Nout");
  ncoeff = (nin+1) * nout;
  fit = get_mortalspace( ncoeff, 'd' );

  ASTCALL(
    status = astLinearApprox( this, clbnd, cubnd, tol, fit );
  )
  if ( status == 0) {
    XSRETURN_EMPTY;
  } else {
    for (i = 0; i < ncoeff; i++) {
      XPUSHs( sv_2mortal( newSVnv( fit[i] ) ) );
    }
  }
#endif

# astMapBox
# ($lbnd_out, $ubnd_out, \@xl, \@xu) = $mapping->MapBox(\@lbnd_in, \@ubnd_in, $forward, $coord_out);

void
astMapBox( this, lbnd_in, ubnd_in, forward, coord_out )
  AstMapping * this
  AV * lbnd_in
  AV * ubnd_in
  int forward
  int coord_out
 PREINIT:
  int nin;
  int len;
  double * clbnd = NULL;
  double * cubnd = NULL;
  double * cxl = NULL;
  double * cxu = NULL;
  double lbnd_out;
  double ubnd_out;
  AV * xl = NULL;
  AV * xu = NULL;
 PPCODE:
  nin = astGetI( this, "Nin" );
  len = av_len( lbnd_in ) + 1;
  if ( len != nin ) Perl_croak( aTHX_ "lbnd must contain %d elements", nin );
  len = av_len( ubnd_in ) + 1;
  if ( len != nin ) Perl_croak( aTHX_ "ubnd must contain %d elements", nin );
  clbnd = pack1D(newRV_noinc((SV*)lbnd_in), 'd' );
  cubnd = pack1D(newRV_noinc((SV*)ubnd_in), 'd' );

  /* Return arrays */
  cxl = get_mortalspace( nin, 'd' );
  cxu = get_mortalspace( nin, 'd' );

  ASTCALL(
    astMapBox( this, clbnd, cubnd, forward, coord_out,
               &lbnd_out, &ubnd_out, cxl, cxu );
  )

  /* Push results */
  XPUSHs(sv_2mortal(newSVnv(lbnd_out)));
  XPUSHs(sv_2mortal(newSVnv(ubnd_out)));

  xl = newAV();
  unpack1D( newRV_noinc((SV*) xl), cxl, 'd', nin );
  XPUSHs( newRV_noinc( (SV*)xl ));
  xu = newAV();
  unpack1D( newRV_noinc((SV*) xu), cxu, 'd', nin );
  XPUSHs( newRV_noinc( (SV*)xu ));


# astMapSplit
# One argument: The indices of the mapping to extract
# Two return arguments: A mapping and a list of indices
#  ($map, @indices) = $map->MapSplit( \@indices );
void
astMapSplit( this, in )
  AstMapping * this
  AV * in
 PREINIT:
  int i;
  int nin;
  int nout;
  int * cin;
  int * cout;
  AstMapping * outmap = NULL;
 PPCODE:
#ifndef HASMAPSPLIT
  Perl_croak(aTHX_ "astMapSplit: Please upgrade to AST V5.3 or greater");
#else
  nin = av_len( in ) + 1;
  cin = pack1D(newRV_noinc((SV*)in), 'i');

  /* output array */
  nout = astGetI( this, "Nout" );
  cout = get_mortalspace( nout, 'i' );

  ASTCALL(
    astMapSplit( this, nin, cin, cout, &outmap );
  )

  /* Push the results onto the stack */
  if (outmap) {
    SV * sv = createPerlObject( "AstMappingPtr", (AstObject*)outmap );
    XPUSHs(sv_2mortal( sv ));
    /* recalculate nout */
    nout = astGetI( outmap, "Nout" );
    for (i = 0; i < nout; i++) {
      XPUSHs( sv_2mortal( newSViv( cout[i] ) ) );
    }
  } else {
    XSRETURN_EMPTY;
  }
#endif

# astRate
#  Returns the rate and (sometimes) the second derivatives
#  Returns empty list if astRate returns AST__BAD

void
astRate( this, at, ax1, ax2 )
  AstMapping * this
  AV* at
  int ax1
  int ax2
 PREINIT:
  int nin;
  int len;
  double * cat;
  double d2;
 PPCODE:
#ifndef HASRATE
   Perl_croak(aTHX_ "astRate: Please upgrade to AST V3.x or greater");
#else
  nin = astGetI( this, "Nin");
  len = av_len( at ) + 1;
  if (nin != len)
      Perl_croak(aTHX_ "Must supply Nin coordinates to astRate [%d != %d]",
                        nin, len);
  cat = pack1D( newRV_noinc((SV*)at), 'd');
  myAstRate( this, cat ,ax1, ax2, &d2 );
#endif


# astResample XXXX


AstMapping *
astSimplify( this )
  AstMapping * this
 CODE:
  ASTCALL(
   RETVAL = astSimplify( this );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

# astTran1
#   Returns one array
# Even though we return one array, we use PPCODE so that it is closer to
# the code used for astTran2

void
astTran1( this, xin, forward )
  AstMapping * this
  AV* xin
  bool forward
 PREINIT:
  int len1;
  double * cxin;
  AV* xout;
  double * cxout;
  SV** elem;
 PPCODE:
  len1 = av_len( xin ) + 1;
  cxin = pack1D( newRV_noinc((SV*)xin), 'd');
  cxout = get_mortalspace( len1, 'd' );

  ASTCALL(
    astTran1( this, len1, cxin, forward, cxout );
  )

  xout = newAV();
  unpack1D( newRV_noinc((SV*) xout), cxout, 'd', len1);

  XPUSHs( newRV_noinc((SV*) xout ));


# astTran2
#   Returns 2 arrays

void
astTran2( this, xin, yin, forward )
  AstMapping * this
  AV* xin
  AV* yin
  bool forward
 PREINIT:
  int len1;
  int len2;
  double * cxin;
  double * cyin;
  AV* xout;
  AV* yout;
  double * cxout;
  double * cyout;
  SV** elem;
 PPCODE:
  len1 = av_len( xin ) + 1;
  len2 = av_len( yin ) + 1;
  if ( len1 != len2 )
     Perl_croak(aTHX_ "Number of elements in input arrays must be identical (%d != %d )",
             len1, len2);
  cxin = pack1D( newRV_noinc((SV*)xin), 'd');
  cyin = pack1D( newRV_noinc((SV*)yin), 'd');
  cxout = get_mortalspace( len1, 'd' );
  cyout = get_mortalspace( len2, 'd' );

  ASTCALL(
    astTran2( this, len1, cxin, cyin, forward, cxout, cyout );
  )

  xout = newAV();
  yout = newAV();
  unpack1D( newRV_noinc((SV*) xout), cxout, 'd', len1);
  unpack1D( newRV_noinc((SV*) yout), cyout, 'd', len2);

  XPUSHs( newRV_noinc((SV*) xout ));
  XPUSHs( newRV_noinc((SV*) yout ));


# astTranN  XXXX

# astTranP

# Note that to allow a better perl interface, we put all the array
# arguments at the end and allow an arbitrary number of coordinates
# to be provided without having to use an array of arrays

# To match the interface to astTranP there must be an input array
# per input axis, and each array must contain the same number of elements
# referring to the coordinate for a specific dimension. ie for a 2D coordinate
# you will need just two arrays: the first array has all the X coordinates
# and the second has all the Y coordinates.

#  @transformed = $wcs->TranP( 1, [ 1,0 ], [1,-1] ... );

void
astTranP( this, forward, ... )
  AstMapping * this
  int forward
 PREINIT:
  int i;
  int n;
  int argoff = 2; /* number of fixed arguments */
  int ndims;
  int npoint;
  int naxin;
  int naxout;
  int ncoord_in;
  int ncoord_out;
  double **ptr_in;
  double **ptr_out;
 PPCODE:
  /* Make sure we have some coordinates to transform */
  ndims = items - argoff;
  if (ndims > 0) {
    /* Number of in and output coordinates required for this mapping */
    naxin = astGetI( this, "Nin" );
    naxout = astGetI( this, "Nout" );

    /* The required dimensionality depends on direction */
    if (forward) {
      ncoord_in = naxin;
      ncoord_out = naxout;
    } else {
      ncoord_in = naxout;
      ncoord_out = naxin;
    }

    /* Make sure that the number of supplied arguments matches the
       number of required input dimensions */
    if ( ndims != ncoord_in )
      Perl_croak(aTHX_ "Number of input arrays must be identical to the number of coordinates in the input frame (%d != %d )", ndims, ncoord_in);

    /* Get some memory for the input and output pointer arrays */
    ptr_in = get_mortalspace( ncoord_in, 'v' );
    ptr_out = get_mortalspace( ncoord_out, 'v' );

    /* Need to get the number of input elements in the first array */
    npoint = (int)nelem1D( ST(argoff) );

    /* Loop over all the remaining arrays and store them in an array */
    for (i = argoff; i<items; i++) {
       int count = i - argoff;
       /* input coordinates */
       ptr_in[count] = pack1D( ST(i), 'd' );

       /* Check size */
       n = nelem1D( ST(i) );
       if (n != npoint)
          Perl_croak(aTHX_ "Input array %d has differing number of elements to first array (%d != %d)",
                     count, n, npoint);

    }
    /* Allocate memory for the output coordinates */
    for (i = 0; i < ncoord_out; i++) {
       ptr_out[i] = get_mortalspace( npoint, 'd' );
    }

    /* Call AST */
    ASTCALL (
      astTranP( this, npoint, ncoord_in, (const double**)ptr_in, forward, ncoord_out, ptr_out);
    )

    /* Copy the output to perl */
    for (i = 0; i < ncoord_out; i++) {
       AV* outarr = newAV();
       unpack1D( newRV_noinc((SV*)outarr), ptr_out[i], 'd', npoint);
       XPUSHs( newRV_noinc((SV*)outarr) );
    }

  } else {
    /* no input, no output */
    XSRETURN_EMPTY;
  }

MODULE = Starlink::AST   PACKAGE = Starlink::AST::RateMap

AstRateMap *
new( class, map, ax1, ax2, options )
  char * class
  AstMapping * map
  int ax1
  int ax2
  char * options
 CODE:
#ifndef HASRATEMAP
  Perl_croak(aTHX_ "astRateMap: Please upgrade to AST V3.5 or newer");
#else
  ASTCALL(
    RETVAL = astRateMap( map, ax1, ax2, options );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Channel PREFIX = ast

AstObject *
ast_Read( channel )
  AstChannel * channel
 CODE:
  ASTCALL(
   RETVAL = astRead( channel );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
 OUTPUT:
  RETVAL

int
astWrite( channel, object )
  AstChannel * channel
  AstObject * object
 CODE:
  ASTCALL(
   RETVAL = astWrite( channel, object );
  )
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Region PREFIX = ast

AstFrame *
astGetRegionFrame( this )
  AstRegion * this
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astGetRegionFrame: Please upgrade to AST V3.5 or greater");
#else
  ASTCALL(
    RETVAL = astGetRegionFrame( this );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

AstRegion *
astMapRegion( this, map, frame )
  AstRegion * this
  AstMapping * map
  AstFrame * frame
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astMapRegion: Please upgrade to AST V3.5 or greater");
#else
  ASTCALL(
    RETVAL = astMapRegion( this, map, frame );
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

# Takes as input a data array and associated pixel bounds, and returns
# the modified data array and the number of values masked within it.
# Fortran order is assumed. This routine should really be implemented
# using PDLs rather than perl linear arrays
# NOT PROPERLY IMPLEMENTED

void
astMaskD( this, map, inside, lbnd, ubnd, in, val)
  AstRegion * this
  AstMapping * map
  bool inside
  AV * lbnd
  AV * ubnd
  AV * in
  double val
 PREINIT:
  int len;
  int ndims;
  int * clbnd;
  int * cubnd;
  double * cin;
  int nelem;
  int i;
  AV * output;
  int nmasked;
 PPCODE:
#ifndef HASREGION
  Perl_croak(aTHX_ "astNegate: Please upgrade to AST V3.5 or greater");
#else
  ndims = astGetI( map, "Nout" );
  len = av_len( lbnd ) + 1;
  if ( len != ndims ) Perl_croak( aTHX_ "lbnd must contain %d elements", ndims );
  len = av_len( ubnd ) + 1;
  if ( len != ndims ) Perl_croak( aTHX_ "ubnd must contain %d elements", ndims );
  clbnd = pack1D(newRV_noinc((SV*)lbnd), 'd');
  cubnd = pack1D(newRV_noinc((SV*)ubnd), 'd');
  cin = pack1D( newRV_noinc((SV*)in), 'd' );
  ASTCALL(
     nmasked = astMaskD( this, map, inside, ndims, clbnd, cubnd, cin, val);
   )
  /* but now need to unroll the data array into a perl array */
  nelem = cubnd[0] - clbnd[0];
  for ( i=1; i < ndims; i++ ) {
    nelem *= ( cubnd[i] - clbnd[i] );
  }
  output = newAV();
  unpack1D( newRV_noinc((SV*) output), cin, 'd', nelem);
  XPUSHs( newRV_noinc((SV*)output));
  XPUSHs( sv_2mortal(newSVnv(nmasked)));
#endif

void
astNegate( this )
  AstRegion * this
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astNegate: Please upgrade to AST V3.5 or greater");
#else
  ASTCALL(
    astNegate( this );
  )
#endif

int
astOverlap( this, that )
  AstRegion * this
  AstRegion * that
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astOverlap: Please upgrade to AST V3.5 or greater");
#else
  ASTCALL(
    RETVAL = astOverlap( this, that );
  )
#endif
 OUTPUT:
  RETVAL

void
astSetUnc( this, unc )
  AstRegion * this
  AstRegion * unc
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astSetUnc: Please upgrade to AST V3.5 or greater");
#else
  ASTCALL(
    astSetUnc( this, unc );
  )
#endif

# astGetRegionBounds
# (\@lbnd, \@ubnd) = $region->GetRegionBounds();

void
astGetRegionBounds( this )
  AstRegion * this
 PREINIT:
  int naxes;
  int i;
  double * clbnd;
  double * cubnd;
  AV * lbnd;
  AV * ubnd;
 PPCODE:
#ifndef HASREGION
  Perl_croak(aTHX_ "astGetRegionBounds: Please upgrade to AST V3.5 or greater");
#else
  naxes = astGetI( this, "Naxes" );
  clbnd = get_mortalspace( naxes, 'd' );
  cubnd = get_mortalspace( naxes, 'd' );

  ASTCALL(
    astGetRegionBounds( this, clbnd, cubnd );
  )

  lbnd = newAV();
  ubnd = newAV();
  unpack1D( newRV_noinc((SV*) lbnd), clbnd, 'd', naxes );
  unpack1D( newRV_noinc((SV*) ubnd), cubnd, 'd', naxes );

  XPUSHs(newRV_noinc((SV*) lbnd));
  XPUSHs(newRV_noinc((SV*) ubnd));
#endif

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Ellipse

AstEllipse *
new( class, frame, form, centre, point1, point2, unc, options)
  char * class
  AstFrame * frame
  int form
  AV * centre
  AV * point1
  AV * point2
  AstRegion * unc
  char * options
 PREINIT:
  int naxes = 2;
  int len;
  int nreq;
  double * ccentre;
  double * cpoint1;
  double * cpoint2;
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astEllipse: Please upgrade to AST V3.5 or greater");
#else
  len = av_len( centre ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "centre must contain %d elements", naxes );
  len = av_len( point1 ) + 1;
  if ( len != 2 ) Perl_croak( aTHX_ "point1 must contain %d elements", 2 );
  len = av_len( point2 ) + 1;
  if (form == 0) {
    nreq = naxes;
  } else {
    nreq = 1;
  }
  if ( len != nreq ) Perl_croak( aTHX_ "point2 must contain %d elements not %d", nreq, len );
  ccentre = pack1D(newRV_noinc((SV*)centre), 'd');
  cpoint1 = pack1D(newRV_noinc((SV*)point1), 'd');
  cpoint2 = pack1D(newRV_noinc((SV*)point2), 'd');
  ASTCALL(
     RETVAL = astEllipse( frame, form, ccentre, cpoint1, cpoint2, unc, options);
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL


MODULE = Starlink::AST   PACKAGE = Starlink::AST::Box

AstBox *
new( class, frame, form, point1, point2, unc, options )
  char * class
  AstFrame * frame
  int form
  AV * point1
  AV * point2
  AstRegion * unc
  char * options
 PREINIT:
  double * cpoint2;
  double * cpoint1;
  int len;
  int naxes;
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astBox: Please upgrade to AST V3.5 or greater");
#else
  naxes = astGetI( frame, "Naxes" );
  len = av_len( point1 ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "point1 must contain %d elements", naxes );
  len = av_len( point2 ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "point2 must contain %d elements", naxes );
  cpoint1 = pack1D(newRV_noinc((SV*)point1), 'd');
  cpoint2 = pack1D(newRV_noinc((SV*)point2), 'd');
   ASTCALL(
     RETVAL = astBox( frame, form, cpoint1, cpoint2, unc, options);
   )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Interval

AstInterval *
new( class, frame, lbnd, ubnd, unc, options )
  char * class
  AstFrame * frame
  AV * lbnd
  AV * ubnd
  AstRegion * unc
  char * options
 PREINIT:
  double * clbnd;
  double * cubnd;
  int len;
  int naxes;
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astInterval: Please upgrade to AST V3.5 or greater");
#else
  naxes = astGetI( frame, "Naxes" );
  len = av_len( lbnd ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "lbnd must contain %d elements", naxes );
  len = av_len( ubnd ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "ubnd must contain %d elements", naxes );
  clbnd = pack1D(newRV_noinc((SV*)lbnd), 'd');
  cubnd = pack1D(newRV_noinc((SV*)ubnd), 'd');
   ASTCALL(
     RETVAL = astInterval( frame, clbnd, cubnd, unc, options);
   )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Polygon

# Note that the interface differs to the low level routine

AstPolygon *
new( class, frame, xpoints, ypoints, unc, options )
  char * class
  AstFrame * frame
  AV * xpoints
  AV * ypoints
  AstRegion * unc
  char * options
 PREINIT:
  int i;
  int xlen;
  int ylen;
  double * points;
  double * cxpoints;
  double * cypoints;
  double * x;
  double * y;
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astPolygon: Please upgrade to AST V3.5 or greater");
#else
   /* count elements */
   xlen = av_len( xpoints ) + 1;
   ylen = av_len( ypoints ) + 1;
   if ( xlen != ylen ) Perl_croak( aTHX_ "number of x and y points differ (%d != %d)",
                           xlen, ylen );
   cxpoints = pack1D(newRV_noinc((SV*)xpoints), 'd');
   cypoints = pack1D(newRV_noinc((SV*)ypoints), 'd');

   /* Create memory for the array as required by AST */
   points = get_mortalspace( xlen * 2, 'd');

   /* copy points in */
   x = points;
   y = points + xlen; /* offset into the array */
   for (i = 0; i < xlen; i++ ) {
     x[i] = cxpoints[i];
     y[i] = cypoints[i];
   }

   ASTCALL(
     RETVAL = astPolygon(frame, xlen, xlen, points, unc, options );
   )
   if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::NullRegion

AstNullRegion *
new( class, frame, unc, options )
  char * class
  AstFrame * frame
  AstRegion * unc
  char * options
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astNullRegion: Please upgrade to AST V3.5 or greater");
#else
   ASTCALL(
     RETVAL = astNullRegion( frame, unc, options);
   )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Region	PREFIX = ast

# Note that we are trying to make this a method in the Region base class
# so that all regions can be converted into CmpRegions

AstCmpRegion *
astCmpRegion( region1, region2, oper, options )
  AstRegion * region1
  AstRegion * region2
  int oper
  char * options
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astCmpRegion: Please upgrade to AST V3.5 or greater");
#else
   ASTCALL(
     RETVAL = astCmpRegion( region1, region2, oper, options);
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL

int
AST__AND()
 CODE:
#ifdef AST__AND
    RETVAL = AST__AND;
#else
    Perl_croak(aTHX_ "Constant AST__AND not defined\n");
#endif
 OUTPUT:
  RETVAL

int
AST__OR()
 CODE:
#ifdef AST__OR
    RETVAL = AST__OR;
#else
    Perl_croak(aTHX_ "Constant AST__OR not defined\n");
#endif
 OUTPUT:
  RETVAL


MODULE = Starlink::AST   PACKAGE = Starlink::AST::Circle

AstCircle *
new( class, frame, form, centre, point, unc, options )
  char * class
  AstFrame * frame
  int form
  AV * centre
  AV * point
  AstRegion * unc
  char * options
 PREINIT:
  double * ccentre;
  double * cpoint;
  int len;
  int naxes;
  int nform;
 CODE:
#ifndef HASREGION
   Perl_croak(aTHX_ "astCircle: Please upgrade to AST V3.5 or greater");
#else
  naxes = astGetI( frame, "Naxes" );
  len = av_len( centre ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "point1 must contain %d elements", naxes );
  /* point depends on form */
  len = av_len( point ) + 1;
  if (form == 0) {
    nform = naxes;
  } else {
    nform = 1;
  }
  if ( len != nform ) Perl_croak( aTHX_ "point() must contain %d elements", nform );
  ccentre = pack1D(newRV_noinc((SV*)centre), 'd');
  cpoint = pack1D(newRV_noinc((SV*)point), 'd');
  ASTCALL(
     RETVAL = astCircle( frame, form, ccentre, cpoint, unc, options);
  )
  if ( RETVAL == AST__NULL ) XSRETURN_UNDEF;
#endif
 OUTPUT:
  RETVAL


MODULE = Starlink::AST   PACKAGE = Starlink::AST::FitsChan PREFIX = ast

void
astPutCards( this, cards )
  AstFitsChan * this
  char * cards
 CODE:
#ifndef HASPUTCARDS
   Perl_croak(aTHX_ "astPutCards: Please upgrade to AST V3.2 or greater");
#else
  ASTCALL(
    astPutCards( this, cards );
  )
#endif

void
astPutFits( this, card, overwrite )
  AstFitsChan * this
  char * card
  int overwrite
 CODE:
  ASTCALL(
   astPutFits(this, card, overwrite);
  )

void
astDelFits( this )
  AstFitsChan * this
 CODE:
  ASTCALL(
   astDelFits( this );
  )

# Need to handle a NULL card  - XXXXX

int
astFindFits( this, name, card, inc )
  AstFitsChan * this
  char * name
  char * card = NO_INIT
  int inc
 PREINIT:
  char buff[81];
 CODE:
  card = buff;
  ASTCALL(
   RETVAL = astFindFits( this, name, card, inc );
  )
 OUTPUT:
  RETVAL
  card

void
astSetFitsCF( this, name, real, imag, comment, overwrite )
  AstFitsChan * this
  char * name
  double real
  double imag
  char * comment
  int overwrite
 PREINIT:
  double value[2];
 CODE:
#ifndef HASSETFITS
  Perl_croak(aTHX_ "astSetFitsX: Please upgrade to AST v3.5 or newer");
#else
  value[0] = real;
  value[1] = imag;
  ASTCALL(
    astSetFitsCF( this, name, value, comment, overwrite );
  )
#endif

void
astSetFitsCI( this, name, real, imag, comment, overwrite )
  AstFitsChan * this
  char * name
  int real
  int imag
  char * comment
  int overwrite
 PREINIT:
  int value[2];
 CODE:
#ifndef HASSETFITS
  Perl_croak(aTHX_ "astSetFitsX: Please upgrade to AST v3.5 or newer");
#else
  value[0] = real;
  value[1] = imag;
  ASTCALL(
    astSetFitsCI( this, name, value, comment, overwrite );
  )
#endif


void
astSetFitsF( this, name, value, comment, overwrite )
  AstFitsChan * this
  char * name
  double value
  char * comment
  int overwrite
 CODE:
#ifndef HASSETFITS
  Perl_croak(aTHX_ "astSetFitsX: Please upgrade to AST v3.5 or newer");
#else
  ASTCALL(
    astSetFitsF( this, name, value, comment, overwrite );
  )
#endif

void
astSetFitsI( this, name, value, comment, overwrite )
  AstFitsChan * this
  char * name
  int value
  char * comment
  int overwrite
 CODE:
#ifndef HASSETFITS
  Perl_croak(aTHX_ "astSetFitsX: Please upgrade to AST v3.5 or newer");
#else
  ASTCALL(
    astSetFitsI( this, name, value, comment, overwrite );
  )
#endif

void
astSetFitsL( this, name, value, comment, overwrite )
  AstFitsChan * this
  char * name
  bool value
  char * comment
  int overwrite
 PREINIT:
  int bval;
 CODE:
#ifndef HASSETFITS
  Perl_croak(aTHX_ "astSetFitsX: Please upgrade to AST v3.5 or newer");
#else
  bval = ( value ? 1 : 0);
  ASTCALL(
    astSetFitsL( this, name, bval, comment, overwrite );
  )
#endif

void
astSetFitsS( this, name, value, comment, overwrite )
  AstFitsChan * this
  char * name
  char * value
  char * comment
  int overwrite
 CODE:
#ifndef HASSETFITS
  Perl_croak(aTHX_ "astSetFitsX: Please upgrade to AST v3.5 or newer");
#else
  ASTCALL(
    astSetFitsS( this, name, value, comment, overwrite );
  )
#endif

void
astSetFitsCN( this, name, value, comment, overwrite )
  AstFitsChan * this
  char * name
  char * value
  char * comment
  int overwrite
 CODE:
#ifndef HASSETFITS
  Perl_croak(aTHX_ "astSetFitsX: Please upgrade to AST v3.5 or newer");
#else
  ASTCALL(
    astSetFitsCN( this, name, value, comment, overwrite );
  )
#endif

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SpecFrame PREFIX = ast

void
astSetRefPos( this, frm, lon, lat)
  AstSpecFrame * this
  AstSkyFrame * frm
  double lon
  double lat
 CODE:
#ifndef HASSETREFPOS
  Perl_croak(aTHX_ "astSetRefPos: Please upgrade to AST v2.x or newer");
#else
  ASTCALL(
   astSetRefPos( this, frm, lon, lat );
  )
#endif

# XXX frm is allowed to be null here

void
astGetRefPos( this, frm )
  AstSpecFrame * this
  AstSkyFrame * frm
 PREINIT:
  double lon;
  double lat;
 PPCODE:
#ifndef HASGETREFPOS
  Perl_croak(aTHX_ "astGetRefPos: Please upgrade to AST v2.x or newer");
#else
  ASTCALL(
   astGetRefPos( this, frm, &lon, &lat );
  )
  XPUSHs(sv_2mortal(newSVnv(lon)));
  XPUSHs(sv_2mortal(newSVnv(lat)));
#endif

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SlaMap PREFIX = astSla

void
astSlaAdd( this, cvt, args )
  AstSlaMap * this
  char * cvt
  AV* args
 PREINIT:
  double * cargs;
 CODE:
  cargs = pack1D(newRV_noinc((SV*)args), 'd');
  ASTCALL(
   astSlaAdd( this, cvt, cargs );
  )

MODULE = Starlink::AST   PACKAGE = Starlink::AST::SpecMap PREFIX = astSpec

void
astSpecAdd( this, cvt, args )
  AstSpecMap * this
  char * cvt
  AV* args
 PREINIT:
  double * cargs;
 CODE:
  cargs = pack1D(newRV_noinc((SV*)args), 'd');
#ifndef HASSPECADD
  Perl_croak(aTHX_ "astSpecAdd: Please upgrade to AST v2.x or newer");
#else
  ASTCALL(
   astSpecAdd( this, cvt, cargs );
  )
#endif

MODULE = Starlink::AST   PACKAGE = Starlink::AST::Plot  PREFIX = ast

void
astBorder( this )
  AstPlot * this
 PREINIT:
  SV* arg = ST(0);
 CODE:
  PLOTCALL(arg,
	   astBorder(this);
  )

void
astBoundingBox( this )
  AstPlot * this
 PREINIT:
  float clbnd[2];
  float cubnd[2];
  AV* lbnd;
  AV* ubnd;
  SV * arg = ST(0);
 PPCODE:
  PLOTCALL (arg,
   astBoundingBox( this, clbnd, cubnd );
  )
  lbnd = newAV();
  unpack1D( newRV_noinc((SV*) lbnd), clbnd, 'f', 2 );
  ubnd = newAV();
  unpack1D( newRV_noinc((SV*) ubnd), cubnd, 'f', 2 );
  XPUSHs(newRV_noinc((SV*)lbnd ));
  XPUSHs(newRV_noinc((SV*)ubnd ));


void
astClip( this, iframe, lbnd, ubnd )
  AstPlot * this
  int iframe
  AV* lbnd
  AV* ubnd
 PREINIT:
  int len;
  double * clbnd;
  double * cubnd;
  int naxes;
  SV * arg = ST(0);
 CODE:
  naxes = astGetI( this, "Naxes" );
  len = av_len( lbnd ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "lbnd must contain %d elements", naxes );
  len = av_len( ubnd ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "ubnd must contain %d elements", naxes );
  clbnd = pack1D(newRV_noinc((SV*)lbnd), 'd');
  cubnd = pack1D(newRV_noinc((SV*)ubnd), 'd');
  PLOTCALL (arg,
   astClip( this, iframe, clbnd, cubnd );
  )

void
astCurve( this, start, finish )
  AstPlot * this
  AV* start
  AV* finish
 PREINIT:
  int len;
  double * cstart;
  double * cfinish;
  int naxes;
  SV* arg = ST(0);
 CODE:
  naxes = astGetI(this, "Naxes" );
  len = av_len( start ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "start must contain %d elements", naxes );
  len = av_len( finish ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "finish must contain %d elements", naxes);
  cstart = pack1D(newRV_noinc((SV*)start), 'd');
  cfinish = pack1D(newRV_noinc((SV*)finish), 'd');
  PLOTCALL (arg,
   astCurve( this, cstart, cfinish );
  )

void
astGenCurve( this, map )
  AstPlot * this
  AstMapping * map
 PREINIT:
  SV * arg = ST(0);
 CODE:
  PLOTCALL(arg,
   astGenCurve(this, map);
  )

void
astGrid( this )
  AstPlot * this
 PREINIT:
  SV * arg = ST(0);
 CODE:
  PLOTCALL(arg,
   astGrid(this);
  )

void
astGridLine( this, axis, start, length )
  AstPlot * this
  int axis
  AV* start
  double length
 PREINIT:
  double * cstart;
  int naxes;
  int len;
  SV * arg = ST(0);
 CODE:
  naxes = astGetI( this, "Naxes" );
  len = av_len( start ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "start must contain %d elements", naxes );
  cstart = pack1D(newRV_noinc((SV*)start), 'd');
  PLOTCALL(arg,
    astGridLine( this, axis, cstart, length );
  )

# Make this a little different to the published interface
# By requesting @x and @y rather than an array of coordinate doublets.

void
astMark(this, type, ...)
  AstPlot * this
  int type
 PREINIT:
  double * cin;
  int ncoords;
  int nmarks = 0;
  int indim;
  int size;
  int i;
  int total;
  int argoff = 2; /* number of fixed arguments */
  int naxes;
  SV * arg = ST(0);
 CODE:
  /* First make sure we have some arguments */
    if (items > argoff ) {
    /* Number of dimensions should be just the number of stack items */
    ncoords = items - argoff;

    /* and this should equal the number of axes in the frame */
    naxes = astGetI( this, "Naxes" );

    if ( naxes != ncoords )
         Perl_croak(aTHX_ "Number of supplied coordinate sets must equal number of axes in frame [%d != %d]",naxes,ncoords);

    /* Now go through each finding out how long each array is */
    for (i = argoff + 1; i<=items; i++ ) {
        int nelem;
        int index = i - 1;
        SV * coordsv = ST(index);
        AV * curr;
        if (SvROK(coordsv) && SvTYPE(SvRV(coordsv)) == SVt_PVAV) {
          curr = (AV*)SvRV( coordsv );
          nelem = av_len( curr ) + 1;
          if (i == argoff + 1) {
            /* No previous values */
            nmarks = nelem;
          } else if (nmarks != nelem) {
            Perl_croak(aTHX_ "All coordinates must have same number of elements [%d != %d]",nmarks, nelem);
          }
        } else {
          Perl_croak(aTHX_ "Argument %d to Mark() must be ref to array",i);
        }
    }

    /* Get some memory for the array */
    total = nmarks * ncoords;
    cin = get_mortalspace( total, 'd');

    /* and go through the arrays again (but less checking now) */
    for (i = 0; i < ncoords; i++ ) {
        int j;
        int argpos = i + argoff;
        AV * curr = (AV*)SvRV( ST(argpos) );

        for (j = 0; j < nmarks ; j ++ ) {
          SV ** elem = av_fetch( curr, j, 0);
          double dtmp;
          if (elem == NULL ) {
             /* undef */
             dtmp = 0.0;
          } else {
             dtmp = SvNV( *elem );
          }
          /* use pointer arithmetic to make sure that things align
             the way AST expects */
          *(cin + (i * nmarks) + j) = dtmp;
        }
    }

    /* Now call the AST routine */
    PLOTCALL( arg,
       astMark( this, nmarks, ncoords, nmarks, cin, type );
    )

  } else {
    XSRETURN_EMPTY;
  }

# Make this a little different to the published interface
# By requesting @x and @y rather than an array of coordinate doublets.
# [code identical to astMark without the type]

void
astPolyCurve(this, ...)
  AstPlot * this
 PREINIT:
  double * cin;
  int ncoords;
  int npoints = 0;
  int indim;
  int size;
  int i;
  int total;
  int argoff = 1; /* number of fixed arguments */
  int naxes;
  SV * arg = ST(0);
 CODE:
  /* First make sure we have some arguments */
  if (items > argoff ) {
    /* Number of dimensions should be just the number of stack items */
    ncoords = items - argoff;

    /* and this should equal the number of axes in the frame */
    naxes = astGetI( this, "Naxes" );

    if ( naxes != ncoords )
         Perl_croak(aTHX_ "Number of supplied coordinate sets must equal number of axes in frame [%d != %d]",naxes,ncoords);

    /* Now go through each finding out how long each array is */
    for (i = argoff + 1; i<=items; i++ ) {
        int nelem;
        int index = i - 1;
        SV * coordsv = ST(index);
        AV * curr;
        if (SvROK(coordsv) && SvTYPE(SvRV(coordsv)) == SVt_PVAV) {
          curr = (AV*)SvRV( coordsv );
          nelem = av_len( curr ) + 1;
          if (i == argoff + 1) {
            /* No previous values */
            npoints = nelem;
          } else if (npoints != nelem) {
            Perl_croak(aTHX_ "All coordinates must have same number of elements [%d != %d]",npoints, nelem);
          }
        } else {
          Perl_croak(aTHX_ "Argument %d to Mark() must be ref to array",i);
        }
    }

    /* Get some memory for the array */
    total = npoints * ncoords;
    cin = get_mortalspace( total, 'd');

    /* and go through the arrays again (but less checking now) */
    for (i = 0; i < ncoords; i++ ) {
        int j;
        int argpos = i + argoff;
        AV * curr = (AV*)SvRV( ST(argpos) );

        for (j = 0; j < npoints ; j ++ ) {
          SV ** elem = av_fetch( curr, j, 0);
          double dtmp;
          if (elem == NULL ) {
             /* undef */
             dtmp = 0.0;
          } else {
             dtmp = SvNV( *elem );
          }
          /* use pointer arithmetic to make sure that things align
             the way AST expects */
          *(cin + (i * npoints) + j) = dtmp;
        }
    }

    /* Now call the AST routine */
    PLOTCALL( arg,
       astPolyCurve( this, npoints, ncoords, npoints, cin );
    )

  } else {
    XSRETURN_EMPTY;
  }

void
astText( this, text, pos, up, just )
  AstPlot * this
  char * text
  AV* pos
  AV* up
  char * just
 PREINIT:
  int len;
  float * cup;
  double * cpos;
  int naxes;
  SV * arg = ST(0);
 CODE:
  naxes = astGetI( this, "Naxes" );
  len = av_len( pos ) + 1;
  if ( len != naxes ) Perl_croak( aTHX_ "pos must contain %d elements", naxes);
  len = av_len( up ) + 1;
  if ( len != 2 ) Perl_croak( aTHX_ "up must contain 2 elements");
  cpos = pack1D(newRV_noinc((SV*)pos), 'd');
  cup = pack1D(newRV_noinc((SV*)up), 'f');
  PLOTCALL(arg,
    astText( this, text, cpos, cup, just );
  )


# Constants

# Start with errors. Bless them into class Starlink::AST::Status

INCLUDE: AST_ERR.xsh

# Then the WcsMap constants

INCLUDE: AST_WCSMAP.xsh

# Then the Grf constants

INCLUDE: AST_GRF.xsh