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

extern void ranu2_(long*,float*,int*,int*);
extern void ranu3_(long*,float*,int*,int*,long*,int*);
extern void rann1_(float*,float*,long*,float*,int*,int*);
extern void rann2_(float*,float*,long*,float*,int*,int*);
extern void rane2_(float*,long*,float*,int*,int*);
extern void ranp2_(float*,long*,int*,int*,float*,int*,int*);
extern void ranb2_(int*,float*,long*,int*,int*,float*,int*,int*);
extern void ratf1_(float*,int*,int*,float*,int*,int*,float*,long*,int*);
extern void ratr1_(float*,int*,int*,float*,int*,int*,float*,long*,int*);


static VALUE
rb_ranu2(self, ix, n)
     VALUE self, ix, n;
{
  long cix;
  float *a;
  int cn;
  int icon;

  VALUE na;
  int shape[1];

  cix = NUM2LONG(ix);
  if ( cix < 0 )
    rb_raise(rb_eRuntimeError, "ix must be >= 0");

  cn = NUM2INT(n);
  if ( cn < 1 )
    rb_raise(rb_eRuntimeError, "n must be >= 1");

  a = ALLOC_N(float,cn);

  ranu2_(&cix,a,&cn,&icon);

  shape[0] = cn;
  na = ssl2_getary(a,1,shape);
  free(a);

  ssl2_error(icon);
  return rb_ary_new3(2,na,INT2NUM(cix));
}


static VALUE
rb_ranu3(argc, argv, self)
     int argc; VALUE *argv, self;
{
  long cix;
  float *a;
  int cn;
  int isw;
  long *civw;
  int icon;

  VALUE ix, n, ivw;

  VALUE na, nivw;
  int shape[1];

  int nn;

  rb_scan_args(argc, argv, "21", &ix, &n, &ivw);

  if ( ivw==Qnil ) {
    civw = ALLOC_N(long,128);
    isw = 0;
  }
  else {
    civw = ssl2_getcaryl(ivw,&nn);
    if ( nn!=128 )
      rb_raise(rb_eRuntimeError, "ivw.length must be 128");
    isw = 1;
  }

  cix = NUM2LONG(ix);
  if ( cix < 0 )
    rb_raise(rb_eRuntimeError, "ix must be >= 0");

  cn = NUM2INT(n);
  if ( cn < 1 )
    rb_raise(rb_eRuntimeError, "n must be >= 1");

  a = ALLOC_N(float,cn);

  ranu3_(&cix,a,&cn,&isw,civw,&icon);

  shape[0] = cn;
  na = ssl2_getary(a,1,shape);
  free(a);
  shape[0] = 128;
  nivw = ssl2_getaryl(civw,1,shape);
  free(civw);

  ssl2_error(icon);
  return rb_ary_new3(3,na,INT2NUM(cix),nivw);
}


static VALUE
rb_rann1(self, am, sd, ix, n)
     VALUE self, am, sd, ix, n;
{
  float cam;
  float csd;
  long cix;
  float *a;
  int cn;
  int icon;

  VALUE na;
  int shape[1];

  cam = (float) NUM2DBL(am);
  csd = (float) NUM2DBL(sd);

  cix = NUM2LONG(ix);
  if ( cix < 0 )
    rb_raise(rb_eRuntimeError, "ix must be >= 0");

  cn = NUM2INT(n);
  if ( cn < 1 )
    rb_raise(rb_eRuntimeError, "n must be >= 1");

  a = ALLOC_N(float,cn);

  rann1_(&cam,&csd,&cix,a,&cn,&icon);

  shape[0] = cn;
  na = ssl2_getary(a,1,shape);

  ssl2_error(icon);
  return rb_ary_new3(2,na,INT2NUM(cix));
}


static VALUE
rb_rann2(self, am, sd, ix, n)
     VALUE self, am, sd, ix, n;
{
  float cam;
  float csd;
  long cix;
  float *a;
  int cn;
  int icon;

  VALUE na;
  int shape[1];

  cam = (float) NUM2DBL(am);
  csd = (float) NUM2DBL(sd);

  cix = NUM2LONG(ix);
  if ( cix < 0 )
    rb_raise(rb_eRuntimeError, "ix must be >= 0");

  cn = NUM2INT(n);
  if ( cn < 1 )
    rb_raise(rb_eRuntimeError, "n must be >= 1");

  a = ALLOC_N(float,cn);

  rann2_(&cam,&csd,&cix,a,&cn,&icon);

  shape[0] = cn;
  na = ssl2_getary(a,1,shape);

  ssl2_error(icon);
  return rb_ary_new3(2,na,INT2NUM(cix));
}


static VALUE
rb_rane2(self, am, ix, n)
     VALUE self, am, ix, n;
{
  float cam;
  long cix;
  float *a;
  int cn;
  int icon;

  VALUE na;
  int shape[1];

  cam = (float) NUM2DBL(am);
  if ( cam <= 0 )
    rb_raise(rb_eRuntimeError, "am must be > 0");

  cix = NUM2LONG(ix);
  if ( cix < 0 )
    rb_raise(rb_eRuntimeError, "ix must be >= 0");

  cn = NUM2INT(n);
  if ( cn < 1 )
    rb_raise(rb_eRuntimeError, "n must be >= 1");

  a = ALLOC_N(float,cn);

  rane2_(&cam,&cix,a,&cn,&icon);

  shape[0] = cn;
  na = ssl2_getary(a,1,shape);

  ssl2_error(icon);
  return rb_ary_new3(2,na,INT2NUM(cix));
}


static VALUE
rb_ranp2(argc, argv, self)
     int argc; VALUE *argv, self;
{
  float cam;
  long cix;
  int *ia;
  int cn;
  float *cvw;
  int *civw;
  int icon;

  VALUE am, ix, n, vw, ivw;

  VALUE nia, nvw, nivw;
  int shape[1];

  int nn;

  rb_scan_args(argc, argv, "32", &am, &ix, &n, &vw, &ivw);

  cam = (float) NUM2DBL(am);
  if ( cam <= 0 )
    rb_raise(rb_eRuntimeError, "am must be > 0");

  cix = NUM2LONG(ix);
  if ( cix < 0 )
    rb_raise(rb_eRuntimeError, "ix must be >= 0");

  cn = NUM2INT(n);
  if ( cn < 1 )
    rb_raise(rb_eRuntimeError, "n must be >= 1");

  ia = ALLOC_N(int,cn);

  if ( vw==Qnil || ivw==Qnil ) {
    cvw = ALLOC_N(float,ceil(2*cam+10));
    civw = ALLOC_N(int,ceil(2*cam+10));
  }
  else if ( vw!=Qnil && ivw!=Qnil ) {
    cvw = ssl2_getcary(vw,&nn);
    if ( nn!=ceil(2*cam+10) )
      rb_raise(rb_eRuntimeError, "vw.length must be ceil(2*m+10)");
    civw = ssl2_getcaryi(ivw,&nn);
    if ( nn!=ceil(2*cam+10) )
      rb_raise(rb_eRuntimeError, "ivw.length must be ceil(2*m+10)");
  }
  else
    rb_raise(rb_eRuntimeError, "vw and ivw must be specify at same time");

  ranp2_(&cam,&cix,ia,&cn,cvw,civw,&icon);

  shape[0] = cn;
  nia = ssl2_getaryi(ia,1,shape);
  free(ia);
  shape[0] = ceil(2*cam+10);
  nvw = ssl2_getary(cvw,1,shape);
  nivw = ssl2_getaryi(civw,1,shape);
  free(cvw);
  free(civw);

  ssl2_error(icon);
  return rb_ary_new3(4,nia,INT2NUM(cix),nvw,nivw);
}


static VALUE
rb_ranb2(argc, argv, self)
     int argc; VALUE *argv, self;
{
  int cm;
  float cp;
  long cix;
  int *ia;
  int cn;
  float *cvw;
  int *civw;
  int icon;

  VALUE m, p, ix, n, vw, ivw;

  VALUE nia, nvw, nivw;
  int shape[1];

  int nn;

  rb_scan_args(argc, argv, "42", &m, &p, &ix, &n, &vw, &ivw);

  cm = NUM2INT(m);
  if ( cm < 1 )
    rb_raise(rb_eRuntimeError, "m must be >= 1");

  cp = (float) NUM2DBL(p);
  if ( cp <= 0 )
    rb_raise(rb_eRuntimeError, "p must be > 0");
  if ( cp >= 1 )
    rb_raise(rb_eRuntimeError, "p must be < 1");

  cix = NUM2LONG(ix);
  if ( cix < 0 )
    rb_raise(rb_eRuntimeError, "ix must be >= 0");

  cn = NUM2INT(n);
  if ( cn < 1 )
    rb_raise(rb_eRuntimeError, "n must be >= 1");

  ia = ALLOC_N(int,cn);

  if ( vw==Qnil || ivw==Qnil ) {
    cvw = ALLOC_N(float,cm+1);
    civw = ALLOC_N(int,cm+1);
  }
  else if ( vw!=Qnil && ivw!=Qnil ) {
    cvw = ssl2_getcary(vw,&nn);
    if ( nn!=cm+1 )
      rb_raise(rb_eRuntimeError, "vw.length must be 2*m+10");
    civw = ssl2_getcaryi(ivw,&nn);
    if ( nn!=cm+1 )
      rb_raise(rb_eRuntimeError, "ivw.length must be 2*m+10");
  }
  else
    rb_raise(rb_eRuntimeError, "vw and ivw must be specify at same time");

  ranb2_(&cm,&cp,&cix,ia,&cn,cvw,civw,&icon);

  shape[0] = cn;
  nia = ssl2_getaryi(ia,1,shape);
  free(ia);
  shape[0] = cm+1;
  nvw = ssl2_getary(cvw,1,shape);
  nivw = ssl2_getaryi(civw,1,shape);
  free(cvw);
  free(civw);

  ssl2_error(icon);
  return rb_ary_new3(4,nia,INT2NUM(cix),nvw,nivw);
}


static VALUE
rb_ratf1(argc, argv, self)
     int argc; VALUE *argv, self;
{
  float *ca;
  int n;
  int cl;
  float calp;
  int isw;
  int iflg;
  float *cvw;
  long *civw;
  int icon;

  VALUE a, l, alp, vw, ivw;

  VALUE nvw, nivw;
  int shape[1];

  int nn;

  rb_scan_args(argc, argv, "32", &a, &l, &alp, &vw, &ivw);

  cl = NUM2INT(l);
  if ( cl<2 )
    rb_raise(rb_eRuntimeError,  "l must be >= 2");

  ca = ssl2_getcary(a,&n);
  if ( n<cl )
    rb_raise(rb_eRuntimeError, "n must be >= l");

  calp = (float) NUM2DBL(alp);
  if ( calp <= 0 )
    rb_raise(rb_eRuntimeError, "alp must be > 0");
  if ( calp >= 100 )
    rb_raise(rb_eRuntimeError, "alp must be < 100");

  if ( vw==Qnil || ivw==Qnil ) {
    cvw = ALLOC_N(float,2);
    civw = ALLOC_N(long,cl+1);
    isw = 0;
  }
  else if ( vw!=Qnil && ivw!=Qnil ) {
    cvw = ssl2_getcary(vw,&nn);
    if ( nn!=2 )
      rb_raise(rb_eRuntimeError, "vw.length must be 2");
    civw = ssl2_getcaryl(ivw,&nn);
    if ( nn!=cl+1 )
      rb_raise(rb_eRuntimeError, "ivw.length must be l+1");
    isw = 1;
  }
  else
    rb_raise(rb_eRuntimeError, "vw and ivw must be specify at same time");

  ratf1_(ca,&n,&cl,&calp,&isw,&iflg,cvw,civw,&icon);

  shape[0] = 2;
  nvw = ssl2_getary(cvw,1,shape);
  free(cvw);
  shape[0] = cl+1;
  nivw = ssl2_getaryl(civw,1,shape);
  free(civw);

  ssl2_error(icon);
  return rb_ary_new3(3,iflg,nvw,nivw);
}


static VALUE
rb_ratr1(argc, argv, self)
     int argc; VALUE *argv, self;
{
  float *ca;
  int n;
  int cl;
  float calp;
  int isw;
  int iflg;
  float *cvw;
  long *civw;
  int icon;

  VALUE a, l, alp, vw, ivw;

  VALUE nvw, nivw;
  int shape[1];

  int nn;

  rb_scan_args(argc, argv, "32", &a, &l, &alp, &vw, &ivw);

  cl = NUM2INT(l);
  if ( cl<2 )
    rb_raise(rb_eRuntimeError,  "l must be >= 2");

  ca = ssl2_getcary(a,&n);
  if ( n<cl+2 )
    rb_raise(rb_eRuntimeError, "n must be >= l+2");

  calp = (float) NUM2DBL(alp);
  if ( calp <= 0 )
    rb_raise(rb_eRuntimeError, "alp must be > 0");
  if ( calp >= 100 )
    rb_raise(rb_eRuntimeError, "alp must be < 100");

  if ( vw==Qnil || ivw==Qnil ) {
    cvw = ALLOC_N(float,3);
    civw = ALLOC_N(long,cl+8);
    isw = 0;
  }
  else if ( vw!=Qnil && ivw!=Qnil ) {
    cvw = ssl2_getcary(vw,&nn);
    if ( nn!=3 )
      rb_raise(rb_eRuntimeError, "vw.length must be 3");
    civw = ssl2_getcaryl(ivw,&nn);
    if ( nn!=cl+8 )
      rb_raise(rb_eRuntimeError, "ivw.length must be l+8");
    isw = 1;
  }
  else
    rb_raise(rb_eRuntimeError, "vw and ivw must be specify at same time");

  ratr1_(ca,&n,&cl,&calp,&isw,&iflg,cvw,civw,&icon);

  shape[0] = 2;
  nvw = ssl2_getary(cvw,1,shape);
  free(cvw);
  shape[0] = cl+1;
  nivw = ssl2_getaryl(civw,1,shape);
  free(civw);

  ssl2_error(icon);
  return rb_ary_new3(3,iflg,nvw,nivw);
}


void init_pseudorandom(mSSL2)
     VALUE mSSL2;
{
  rb_define_module_function(mSSL2, "ranu2", rb_ranu2, 2);
  rb_define_module_function(mSSL2, "ranu3", rb_ranu3, -1);
  rb_define_module_function(mSSL2, "rann1", rb_rann1, 4);
  rb_define_module_function(mSSL2, "rann2", rb_rann2, 4);
  rb_define_module_function(mSSL2, "rane2", rb_rane2, 3);
  rb_define_module_function(mSSL2, "ranp2", rb_ranp2, -1);
  rb_define_module_function(mSSL2, "ranb2", rb_ranb2, -1);
  rb_define_module_function(mSSL2, "ratf1", rb_ratf1, -1);
  rb_define_module_function(mSSL2, "ratr1", rb_ratr1, -1);
}