#include <ruby.h>
#include <math.h>
#include <stdio.h>
#include <narray.h>
#include "ssl2.h"

extern void fcost_(float*,int*,float*,int*);
extern void fcosm_(float*,int*,int*,float*,int*);
extern void fsint_(float*,int*,float*,int*);
extern void fsinm_(float*,int*,int*,float*,int*);
extern void rft_(float*,int*,int*,int*);
extern void cftm_(float*,float*,int*,int*,int*,int*);
extern void cft_(float*,float*,int*,int*,int*,int*);
extern void cftn_(float*,float*,int*,int*,int*,int*,int*);
extern void cftr_(float*,float*,int*,int*,int*,int*,int*);
extern void pnr_(float*,float*,int*,int*,int*,int*,int*);
extern void laps1_(float*,int*,float*,int*,float*,float*,int*,float*,float*,float*,int*,float*,int*);
extern void laps2_(float*,int*,float*,int*,float*,float*,int*,float*,float*,float*,int*,float*,int*,float*,int*);
extern void laps3_();
extern void hrwiz_(float*,int*,int*,int*,float*,float*,int*);


static VALUE
rb_fcost(self,a)
     VALUE self,a;
{
  float *ca;
  int n;
  float *ctab;
  int icon;

  VALUE tab;
  int shape[1];

  ca = ssl2_getcary(a,&n);

  ctab = ALLOC_N(float,n/2-1);
  fcost_(ca,&n,ctab,&icon);

  shape[0] = n;
  a = ssl2_getary(ca,1,shape);
  free(ca);
  shape[0] = n/2-1;
  tab = ssl2_getary(ctab,1,shape);
  free(ctab);

  ssl2_error(icon);
  return rb_ary_new3(2,a,tab);
}

static VALUE
rb_fcosm(self,a,isn)
     VALUE self,a,isn;
{
  float *ca;
  int n;
  int cisn;
  float *ctab;
  int icon;

  VALUE tab;
  int shape[1];

  ca = ssl2_getcary(a,&n);
  cisn = NUM2INT(isn);
  if (cisn!=1&&cisn!=-1) rb_raise(rb_eRuntimeError,"isn must be 1 or -1");

  ctab = ALLOC_N(float,n-1);
  fcosm_(ca,&n,&cisn,ctab,&icon);

  shape[0] = n;
  a = ssl2_getary(ca,1,shape);
  free(ca);
  shape[0] = n-1;
  tab = ssl2_getary(ctab,1,shape);
  free(ctab);

  ssl2_error(icon);
  return rb_ary_new3(2,a,tab);
}

static VALUE
rb_fsint(self,a)
     VALUE self,a;
{
  float *ca;
  int n;
  float *ctab;
  int icon;

  VALUE tab;
  int shape[1];

  ca = ssl2_getcary(a,&n);

  ctab = ALLOC_N(float,n/2-1);
  fsint_(ca,&n,ctab,&icon);

  shape[0] = n;
  a = ssl2_getary(ca,1,shape);
  free(ca);
  shape[0] = n/2-1;
  tab = ssl2_getary(ctab,1,shape);
  free(ctab);

  ssl2_error(icon);
  return rb_ary_new3(2,a,tab);
}

static VALUE
rb_fsinm(self,a,isn)
     VALUE self,a,isn;
{
  float *ca;
  int n;
  int cisn;
  float *ctab;
  int icon;

  VALUE tab;
  int shape[1];

  ca = ssl2_getcary(a,&n);
  cisn = NUM2INT(isn);
  if (cisn!=1&&cisn!=-1) rb_raise(rb_eRuntimeError,"isn must be 1 or -1");

  ctab = ALLOC_N(float,n-1);
  fsinm_(ca,&n,&cisn,ctab,&icon);

  shape[0] = n;
  a = ssl2_getary(ca,1,shape);
  free(ca);
  shape[0] = n-1;
  tab = ssl2_getary(ctab,1,shape);
  free(ctab);

  ssl2_error(icon);
  return rb_ary_new3(2,a,tab);
}

static VALUE
rb_rft(self,a,isn)
     VALUE self,a,isn;
{
  float *ca;
  int n;
  int cisn;
  int icon;

  int shape[1];

  ca = ssl2_getcary(a,&n);
  cisn = NUM2INT(isn);
  if (cisn==0) rb_raise(rb_eRuntimeError,"isn==0");

  rft_(ca,&n,&cisn,&icon);

  shape[0] = n;
  a = ssl2_getary(ca,1,shape);
  free(ca);

  ssl2_error(icon);
  return a;
}

static VALUE
rb_cftm(self,z,isn)
     VALUE self,z,isn;
{
  scomplex *cz;
  float *a,*b;
  int *n,m;
  int cisn;
  int icon;

  int i,nn;

  cz = ssl2_getcaryc_withshape(z,&n,&m);
  if (m<=0) rb_raise(rb_eRuntimeError,"z.rank<=0");
  cisn = NUM2INT(isn);
  if (cisn==0) rb_raise(rb_eRuntimeError,"isn==0");

  nn=1;
  for (i=0;i<m;i++) nn *= n[i];
  a = ALLOC_N(float,nn);
  b = ALLOC_N(float,nn);
  for (i=0;i<nn;i++) {
    a[i] = cz[i].r;
    b[i] = cz[i].i;
  }
  cftm_(a,b,n,&m,&cisn,&icon);

  for (i=0;i<nn;i++) {
    cz[i].r = a[i];
    cz[i].i = b[i];
  }
  free(a);
  free(b);
  z = ssl2_getaryc(cz,m,n);
  free(cz);
  free(n);

  ssl2_error(icon);
  return z;
}

static VALUE
rb_cft(self,z,isn)
     VALUE self,z,isn;
{
  scomplex *cz;
  float *a,*b;
  int *n,m;
  int cisn;
  int icon;

  int i,nn;

  cz = ssl2_getcaryc_withshape(z,&n,&m);
  if (m<1) rb_raise(rb_eRuntimeError,"z.rank<1");
  cisn = NUM2INT(isn);
  if (cisn!=1&&cisn!=-1) rb_raise(rb_eRuntimeError,"isn must be 1 or -1");

  nn=1;
  for (i=0;i<m;i++) nn *= n[i];
  a = ALLOC_N(float,nn);
  b = ALLOC_N(float,nn);
  for (i=0;i<nn;i++) {
    a[i] = cz[i].r;
    b[i] = cz[i].i;
  }
  cft_(a,b,n,&m,&cisn,&icon);

  for (i=0;i<nn;i++) {
    cz[i].r = a[i];
    cz[i].i = b[i];
  }
  free(a);
  free(b);
  z = ssl2_getaryc(cz,m,n);
  free(cz);
  free(n);

  ssl2_error(icon);
  return z;
}

static VALUE
rb_cftn(self,z,ns,isn)
     VALUE self,z,ns,isn;
{
  scomplex *cz;
  float *a,*b;
  int nt,n;
  int cns;
  int cisn;
  int icon;

  int *shape,rank;

  int i;

  cz = ssl2_getcaryc_withshape(z,&shape,&rank);
  n = shape[0];
  nt = 1;
  for (i=0;i<rank;i++) nt *= shape[i];
  cns = NUM2INT(ns);
  if (cns>nt) rb_raise(rb_eRuntimeError,"ns > z.length");
  if (cns<1) rb_raise(rb_eRuntimeError,"ns < 1");
  cisn = NUM2INT(isn);
  if (cisn==0) rb_raise(rb_eRuntimeError,"isn==0");

  a = ALLOC_N(float,nt);
  b = ALLOC_N(float,nt);
  for (i=0;i<nt;i++) {
    a[i] = cz[i].r;
    b[i] = cz[i].i;
  }
  cftn_(a,b,&nt,&n,&cns,&cisn,&icon);

  for (i=0;i<nt;i++) {
    cz[i].r = a[i];
    cz[i].i = b[i];
  }
  free(a);
  free(b);
  z = ssl2_getaryc(cz,rank,shape);
  free(cz);
  free(shape);

  ssl2_error(icon);
  return z;
}

static VALUE
rb_cftr(self,z,ns,isn)
     VALUE self,z,ns,isn;
{
  scomplex *cz;
  float *a,*b;
  int nt,n;
  int cns;
  int cisn;
  int icon;

  int *shape,rank;

  int i;

  cz = ssl2_getcaryc_withshape(z,&shape,&rank);
  n = shape[0];
  nt = 1;
  for (i=0;i<rank;i++) nt *= shape[i];
  cns = NUM2INT(ns);
  if (cns>nt) rb_raise(rb_eRuntimeError,"ns > z.length");
  if (cns<1) rb_raise(rb_eRuntimeError,"ns < 1");
  cisn = NUM2INT(isn);
  if (cisn==0) rb_raise(rb_eRuntimeError,"isn==0");

  a = ALLOC_N(float,nt);
  b = ALLOC_N(float,nt);
  for (i=0;i<nt;i++) {
    a[i] = cz[i].r;
    b[i] = cz[i].i;
  }
  cftr_(a,b,&nt,&n,&cns,&cisn,&icon);

  for (i=0;i<nt;i++) {
    cz[i].r = a[i];
    cz[i].i = b[i];
  }
  free(a);
  free(b);
  z = ssl2_getaryc(cz,rank,shape);
  free(cz);
  free(shape);

  ssl2_error(icon);
  return z;
}

static VALUE
rb_pnr(self,z,ns,isn)
     VALUE self,z,ns,isn;
{
  scomplex *cz;
  float *a,*b;
  int nt,n;
  int cns;
  int cisn;
  int icon;

  int *shape,rank;

  int i;

  cz = ssl2_getcaryc_withshape(z,&shape,&rank);
  n = shape[0];
  nt = 1;
  for (i=0;i<rank;i++) nt *= shape[i];
  cns = NUM2INT(ns);
  if (cns>nt) rb_raise(rb_eRuntimeError,"ns > z.length");
  if (cns<1) rb_raise(rb_eRuntimeError,"ns < 1");
  cisn = NUM2INT(isn);
  if (cisn==0) rb_raise(rb_eRuntimeError,"isn==0");

  a = ALLOC_N(float,nt);
  b = ALLOC_N(float,nt);
  for (i=0;i<nt;i++) {
    a[i] = cz[i].r;
    b[i] = cz[i].i;
  }
  cpnr_(a,b,&nt,&n,&cns,&cisn,&icon);

  for (i=0;i<nt;i++) {
    cz[i].r = a[i];
    cz[i].i = b[i];
  }
  free(a);
  free(b);
  z = ssl2_getaryc(cz,rank,shape);
  free(cz);
  free(shape);

  ssl2_error(icon);
  return z;
}

static VALUE
rb_laps1(self,a,b,t,delt,l,epsr)
     VALUE self,a,b,t,delt,l,epsr;
{
  float *ca,*cb;
  int na,nb;
  float ct,cdelt;
  int cl;
  float cepsr;
  float *cft,*ct1;
  int *cneps;
  float *cerrv;
  int icon;

  VALUE ft,t1,neps,errv;
  int shape[1];

  int nn;

  ca = ssl2_getcary(a,&nn);
  na = nn-1;
  if (ca[0]==0) rb_raise(rb_eRuntimeError,"a[0]==0");
  cb = ssl2_getcary(b,&nn);
  nb = nn-1;
  if (nb<0) rb_raise(rb_eRuntimeError,"b.length<1");
  if (nb>na) rb_raise(rb_eRuntimeError,"b.length > a.length");
  ct = NUM2FLT(t);
  if (ct<0) rb_raise(rb_eRuntimeError,"t<0");
  cdelt = NUM2FLT(delt);
  if (cdelt<0) rb_raise(rb_eRuntimeError,"delt < 0");
  cl = NUM2INT(l);
  if (cl<1) rb_raise(rb_eRuntimeError,"l < 1");
  cepsr = NUM2FLT(epsr);
  if (cepsr<0) rb_raise(rb_eRuntimeError,"epsr < 0");

  cft = ALLOC_N(float,cl);
  ct1 = ALLOC_N(float,cl);
  cneps = ALLOC_N(int,cl);
  cerrv = ALLOC_N(float,cl);
  laps1_(ca,&na,cb,&nb,&ct,&cdelt,&cl,&cepsr,cft,ct1,cneps,cerrv,&icon);
  free(ca);
  free(cb);

  shape[0] = cl;
  ft = ssl2_getary(cft,1,shape);
  free(cft);
  t1 = ssl2_getary(ct1,1,shape);
  free(ct1);
  neps = ssl2_getaryi(cneps,1,shape);
  free(cneps);
  errv = ssl2_getary(cerrv,1,shape);
  free(cerrv);

  ssl2_error(icon);
  return rb_ary_new3(4,ft,t1,neps,errv);
}

static VALUE
rb_laps2(self,a,b,t,delt,l,epsr)
     VALUE self,a,b,t,delt,l,epsr;
{
  float *ca,*cb;
  int na,nb;
  float ct,cdelt;
  int cl;
  float cepsr;
  float *cft,*ct1;
  int *cneps;
  float *cerrv;
  int ciflg;
  float *vw;
  int icon;

  VALUE ft,t1,neps,errv;
  int shape[1];

  int nn;

  ca = ssl2_getcary(a,&nn);
  na = nn-1;
  if (ca[0]==0) rb_raise(rb_eRuntimeError,"a[0]==0");
  cb = ssl2_getcary(b,&nn);
  nb = nn-1;
  if (nb<0) rb_raise(rb_eRuntimeError,"b.length<1");
  if (nb>na) rb_raise(rb_eRuntimeError,"b.length > a.length");
  ct = NUM2FLT(t);
  if (ct<0) rb_raise(rb_eRuntimeError,"t<0");
  cdelt = NUM2FLT(delt);
  if (cdelt<0) rb_raise(rb_eRuntimeError,"delt < 0");
  cl = NUM2INT(l);
  if (cl<1) rb_raise(rb_eRuntimeError,"l < 1");
  cepsr = NUM2FLT(epsr);
  if (cepsr<0) rb_raise(rb_eRuntimeError,"epsr < 0");

  cft = ALLOC_N(float,cl);
  ct1 = ALLOC_N(float,cl);
  cneps = ALLOC_N(int,cl);
  cerrv = ALLOC_N(float,cl);
  vw = ALLOC_N(float,na+nb+2);
  laps2_(ca,&na,cb,&nb,&ct,&cdelt,&cl,&cepsr,cft,ct1,cneps,cerrv,&ciflg,vw,&icon);
  free(ca);
  free(cb);
  free(vw);

  shape[0] = cl;
  ft = ssl2_getary(cft,1,shape);
  free(cft);
  t1 = ssl2_getary(ct1,1,shape);
  free(ct1);
  neps = ssl2_getaryi(cneps,1,shape);
  free(cneps);
  errv = ssl2_getary(cerrv,1,shape);
  free(cerrv);

  ssl2_error(icon);
  return rb_ary_new3(5,ft,t1,neps,errv,INT2NUM(ciflg));
}

static VALUE
rb_hrwiz(self,a,isw)
     VALUE self,a,isw;
{
  float *ca;
  int na;
  int cisw;
  int ciflg;
  float csa;
  float *vw;
  int icon;

  int nn;

  ca = ssl2_getcary(a,&nn);
  na = nn-1;
  if (na<1) rb_raise(rb_eRuntimeError,"a.length<2");
  cisw = NUM2INT(isw);
  if (cisw!=0&&cisw!=1) rb_raise(rb_eRuntimeError,"isw must be 0 or 1");

  vw = ALLOC_N(float,na+1);
  hrwiz_(ca,&na,&cisw,&ciflg,&csa,vw,&icon);
  free(ca);
  free(vw);

  ssl2_error(icon);
  return rb_ary_new3(2,FLT2NUM(csa),INT2NUM(ciflg));
}


void init_transforms(mSSL2)
     VALUE mSSL2;
{
  rb_define_module_function(mSSL2, "fcost", rb_fcost, 1);
  rb_define_module_function(mSSL2, "fcosm", rb_fcosm, 2);
  rb_define_module_function(mSSL2, "fsint", rb_fsint, 1);
  rb_define_module_function(mSSL2, "fsinm", rb_fsinm, 2);
  rb_define_module_function(mSSL2, "rft", rb_rft, 1);
  rb_define_module_function(mSSL2, "cftm", rb_cftm, 2);
  rb_define_module_function(mSSL2, "cftn", rb_cftn, 3);
  rb_define_module_function(mSSL2, "cftr", rb_cftr, 3);
  rb_define_module_function(mSSL2, "pnr", rb_pnr, 3);
  rb_define_module_function(mSSL2, "laps1", rb_laps1, 6);
  rb_define_module_function(mSSL2, "laps2", rb_laps2, 6);
  rb_define_module_function(mSSL2, "hrwiz", rb_hrwiz, 2);
}