//
// This file contains the code that handles converting
// to/from S-Lang.
//
// Although written in C++, the code does not make use of the
// features provided by the language.
//

#include <string.h>

#include "slang.h"

//
// This is the routine that evaluates the model. It is
// defined in beta1d_model.cc
//
extern void evaluate_beta1d(double r0,
			    double beta,
			    double xpos,
			    double ampl,
			    double *x,
			    double *y,
			    int nelem);

//
// The following routine is the code that handles the interface
// between S-Lang and your model (in this example the
// evaluate_beta1d routine).
//
// It has to handle converting the parameter and axis
// information from S-Lang, calling the model evaluation
// routine, and then converting the result into a S-Lang array.
//
// The handling of the arguments depends on how the routine
// is registered with S-Lang (the SLadd_intrinsic_function
// routine below). In this case we explicitly list all the
// parameters since we know what types they should be.
// See the "Intrinsic Functions" section of the
// "S-Lang Library C Programmer's Guide" available from
//      http://www.jedsoft.org/slang/docs.html
// for further information on how to add routines to S-Lang
// (although these docs are for S-Lang v2 and CIAO uses
//  S-Lang v1 the interface has not changed).
//
static void beta1d_interface(double *r0,
			     double *beta,
			     double *xpos,
			     double *ampl,
			     SLang_Array_Type *x)
{
  // Safety check. Should not be needed in production code.
  if (SLANG_DOUBLE_TYPE != x->data_type)
  {
    SLang_verror (SL_USAGE_ERROR,
		  (char *) "Usage: _beta1d_um_c (r0, beta, xpos, ampl, Double_Type x[]);");
    SLang_push_null (); // so that things will fail
  }

  // Create memory for output
  int nelem = x->num_elements;
  SLang_Array_Type* y = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &nelem, 1);
  if (NULL==y)
  {
    SLang_verror (SL_MALLOC_ERROR,
		  (char *) "Unable to create an array of %d doubles",
		  nelem);
    SLang_push_null (); // so that things will fail
  }

  // Evaluate the model
  evaluate_beta1d(*r0,
		  *beta,
		  *xpos,
		  *ampl,
		  (double *)(x->data),
		  (double *)(y->data),
		  nelem);
  
  // Return the calculated values to S-Lang.
  // The second argument is set to 1 to avoid memory leaks.
  //
  (void) SLang_push_array (y, 1);
}

//
// This routine is used to tell S-Lang what routines should
// be available from S-Lang.
//
// It must be called init_<name of module>_module_ns
// where the shared library is called
// <name of module>-module.so
//

extern "C" {

SLANG_MODULE(beta1d_um_cc);

int init_beta1d_um_cc_module_ns(char *ns_name)
{
  SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
  if (ns == NULL)
    return -1;

  // We want Sherpa to call the beta1d_interface routine,
  // using the name "_beta1d_um_cc". The leading underscore is
  // not required but does indicate this is a routine that
  // is not expected to be called directly by the user.
  //
  if (-1 == SLadd_intrinsic_function ((char *) "_beta1d_um_cc",
				      (FVOID_STAR) &beta1d_interface,
				      SLANG_VOID_TYPE,
				      5,
				      SLANG_DOUBLE_TYPE,
				      SLANG_DOUBLE_TYPE,
				      SLANG_DOUBLE_TYPE,
				      SLANG_DOUBLE_TYPE,
				      SLANG_ARRAY_TYPE))
    return -1;
  
   return 0;
}

} // extern "C" block

// end
