#! /bin/sh
# a script to set up the interface code for accessing
# FormCalc-generated code in Mathematica
# this file is part of FormCalc
# last modified 18 May 06 th


file=$1
base=`basename $file .F`
name=`echo "$base" | sed s/_//`

set -- `grep '#include \".to.\.F\"' process.h | tr '#include"to.F' ' '`
pol="`expr substr UUUU 1 $1``expr substr UUUU 1 $2`"

set -- `sed '
s/.*call MmaGetReal(/r /
s/.*call MmaGetComplex(/c /
y/_)/$ /
t
d' $file`

while [ $# -gt 0 ] ; do
  case $1 in
  r) argsQ="$argsQ, $2_?r"
     argsL="$argsL, $2_"
     argsR="$argsR, $2"
     argsN="$argsN, N[$2]"
     argsT="$argsT, Real"
     argsC="$argsC, creal $2" ;;
  c) argsQ="$argsQ, $2_?c"
     argsL="$argsL, $2_"
     argsR="$argsR, $2"
     argsN="$argsN, N[Re[$2]], N[Im[$2]]"
     argsT="$argsT, Real, Real"
     argsC="$argsC, creal re$2, creal im$2" ;;
  esac
  shift 2
done

cat << _EOF_ > `dirname $file`/$base.tm
:Evaluate: BeginPackage["XSection\`"]

:Evaluate: Options[$name] = {
  Polarizations -> "$pol",
  Serial -> {},
  ParaHead -> Para,
  DataHead -> Data }

:Evaluate: Begin["\`$name\`"]

:Evaluate: r = Head[# + 1.] === Real &

:Evaluate: c = Head[# + 1. I] === Complex &

:Evaluate: $name[setno_Integer, sqrtS_$argsL, opt___Rule] :=
  Block[ {pol, serial, phead, dhead},
    {pol, serial, phead, dhead} =
      {Polarizations, Serial, ParaHead, DataHead} /.
        {opt} /. Options[$name];
    m$name[setno, ToString[phead], ToString[dhead],
      ToString[pol], Flatten[{sqrtS}], Flatten[{serial}]$argsR]
  ]

:Begin:
:Function: m$name
:Pattern: m$name[setno_Integer, phead_String, dhead_String,
  pol_String,
  {sqrtSfrom_, sqrtSto_:-1, sqrtSstep_:10},
  {serialfrom_:0, serialto_:2^30, serialstep_:1}$argsL]
:Arguments: {setno, phead, dhead, pol,
  N[sqrtSfrom], N[sqrtSto], N[sqrtSstep],
  serialfrom, serialto, serialstep$argsN}
:ArgumentTypes: {Integer, String, String, String,
  Real, Real, Real,
  Integer, Integer, Integer$argsT}
:ReturnType: Manual
:End:

:Evaluate: End[]

:Evaluate: EndPackage[]


/*
	$base.tm
		Mathematica interface to FormCalc-generated code
		generated by `basename $0`
		`date`
*/

#include "mathlink.h"
#ifndef MLCONST
#define MLCONST
#endif

#include <stdarg.h>
#include <stdio.h>
#include <unistd.h>

typedef MLCONST char cchar;
typedef const int cint;
typedef double real;
typedef const real creal;
typedef struct { double re, im; } cplx;
typedef const cplx ccplx;

#if UNDERSCORE
#define ProcessIni	processini_
#define ParameterScan	parameterscan_
#define MmaGetReal	mmagetreal_
#define MmaGetComplex	mmagetcomplex_
#define MmaPutReal	mmaputreal_
#define MmaPutComplex	mmaputcomplex_
#define flush		flush_
#else
#define ProcessIni	processini
#define ParameterScan	parameterscan
#define MmaGetReal	mmagetreal
#define MmaGetComplex	mmagetcomplex
#define MmaPutReal	mmaputreal
#define MmaPutComplex	mmaputcomplex
#endif

extern void ProcessIni(int *fail, cchar *pol,
  creal *sqrtSfrom, creal *sqrtSto, creal *sqrtSstep, cint lenpol);

extern void ParameterScan(cchar *dir,
  cint *serialfrom, cint *serialto, cint *serialstep, cint lendir);

extern void flush(cint *unit);

static va_list xsection_ap;
static int truestdout;

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

static inline void MLSendPacket(MLINK mlp)
{
  int pkt;

  MLEndPacket(mlp);

  do {
    pkt = MLNextPacket(mlp);
    MLNewPacket(mlp);
  } while( pkt != RETURNPKT );
}

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

static void m$name(cint setno, cchar *pol,
  creal sqrtSfrom, creal sqrtSto, creal sqrtSstep,
  cint serialfrom, cint serialto, cint serialstep$argsC)
{
  int fail;
  cint fortranstdout = 6;

  dup2(2, 1);
  ProcessIni(&fail, pol, &sqrtSfrom, &sqrtSto, &sqrtSstep, strlen(pol));

  va_start(xsection_ap, serialstep);
  ParameterScan("", &serialfrom, &serialto, &serialstep, 0);
  va_end(xsection_ap);

  flush(&fortranstdout);
  fflush(stdout);
  dup2(truestdout, 1);
}

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

void MmaGetReal(real *x)
{
  *x = va_arg(xsection_ap, real);
}

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

void MmaGetComplex(cplx *c)
{
  c->re = va_arg(xsection_ap, real);
  c->im = va_arg(xsection_ap, real);
}

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

void MmaPutReal(creal *x)
{
  have_output = 1;
  MLPutReal(stdlink, *x);
}

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

void MmaPutComplex(ccplx *c)
{
  have_output = 1;
  if( c->im == 0 ) MLPutReal(stdlink, c->re);
  else {
    MLPutFunction(stdlink, "Complex", 2);
    MLPutReal(stdlink, c->re);
    MLPutReal(stdlink, c->im);
  }
}

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

int main(int argc, char **argv)
{
  int ret;

  truestdout = dup(1);
  return MLMain(argc, argv);
}

_EOF_

