/*
 * $Id: p_header,v 1.4 2000/11/27 01:57:01 keiko Exp $
 */

#include <stdio.h>
#include "ruby.h"
#include "libtinyf2c.h"
#include "narray.h"

#define DFLT_SIZE 32

extern char    *dcl_obj2ccharary(VALUE, int, int);
extern integer *dcl_obj2cintegerary(VALUE);
extern real    *dcl_obj2crealary(VALUE);
extern complex *dcl_obj2ccomplexary(VALUE);
extern logical *dcl_obj2clogicalary(VALUE);

extern VALUE dcl_ccharary2obj(char *, int, int);
extern VALUE dcl_cintegerary2obj(integer *, int, int, int *);
extern VALUE dcl_crealary2obj(real *, int, int, int *);
extern VALUE dcl_ccomplexary2obj(complex *, int, char *);
extern VALUE dcl_clogicalary2obj(logical *, int, int, int *);

extern void dcl_freeccharary(char *);
extern void dcl_freecintegerary(integer *);
extern void dcl_freecrealary(real *);
extern void dcl_freeccomplexary(complex *);
extern void dcl_freeclogicalary(logical *);

/* for functions which return doublereal */
/* fnclib */
extern doublereal rd2r_(real *);
extern doublereal rr2d_(real *);
extern doublereal rexp_(real *, integer *, integer *);
extern doublereal rfpi_(void);
extern doublereal rmod_(real *, real *);
/* gnmlib */
extern doublereal rgnlt_(real *);
extern doublereal rgnle_(real *);
extern doublereal rgngt_(real *);
extern doublereal rgnge_(real *);
/* rfalib */
extern doublereal rmax_(real *, integer *, integer *);
extern doublereal rmin_(real *, integer *, integer *);
extern doublereal rsum_(real *, integer *, integer *);
extern doublereal rave_(real *, integer *, integer *);
extern doublereal rvar_(real *, integer *, integer *);
extern doublereal rstd_(real *, integer *, integer *);
extern doublereal rrms_(real *, integer *, integer *);
extern doublereal ramp_(real *, integer *, integer *);
/* rfblib */
extern doublereal rprd_(real *, real *, integer *, integer *, integer *);
extern doublereal rcov_(real *, real *, integer *, integer *, integer *);
extern doublereal rcor_(real *, real *, integer *, integer *, integer *);


extern VALUE mDCL;

#if DCLVER >= 53

static VALUE
dcl_g2fbli(obj, p, q, z00, z10, z01, z11)
    VALUE obj, p, q, z00, z10, z01, z11;
{
    real i_p;
    real i_q;
    real i_z00;
    real i_z10;
    real i_z01;
    real i_z11;
    real o_z;
    VALUE z;

    if (TYPE(p) != T_FLOAT) {
      p = rb_funcall(p, rb_intern("to_f"), 0);
    }
    if (TYPE(q) != T_FLOAT) {
      q = rb_funcall(q, rb_intern("to_f"), 0);
    }
    if (TYPE(z00) != T_FLOAT) {
      z00 = rb_funcall(z00, rb_intern("to_f"), 0);
    }
    if (TYPE(z10) != T_FLOAT) {
      z10 = rb_funcall(z10, rb_intern("to_f"), 0);
    }
    if (TYPE(z01) != T_FLOAT) {
      z01 = rb_funcall(z01, rb_intern("to_f"), 0);
    }
    if (TYPE(z11) != T_FLOAT) {
      z11 = rb_funcall(z11, rb_intern("to_f"), 0);
    }

    i_p = (real)NUM2DBL(p);
    i_q = (real)NUM2DBL(q);
    i_z00 = (real)NUM2DBL(z00);
    i_z10 = (real)NUM2DBL(z10);
    i_z01 = (real)NUM2DBL(z01);
    i_z11 = (real)NUM2DBL(z11);


    g2fbli_(&i_p, &i_q, &i_z00, &i_z10, &i_z01, &i_z11, &o_z);

    z = rb_float_new((double)o_z);


    return z;

}

static VALUE
dcl_g2fbl2(obj, p, q, x00, x10, x01, x11, y00, y10, y01, y11)
    VALUE obj, p, q, x00, x10, x01, x11, y00, y10, y01, y11;
{
    real i_p;
    real i_q;
    real i_x00;
    real i_x10;
    real i_x01;
    real i_x11;
    real i_y00;
    real i_y10;
    real i_y01;
    real i_y11;
    real o_x;
    real o_y;
    VALUE x;
    VALUE y;

    if (TYPE(p) != T_FLOAT) {
      p = rb_funcall(p, rb_intern("to_f"), 0);
    }
    if (TYPE(q) != T_FLOAT) {
      q = rb_funcall(q, rb_intern("to_f"), 0);
    }
    if (TYPE(x00) != T_FLOAT) {
      x00 = rb_funcall(x00, rb_intern("to_f"), 0);
    }
    if (TYPE(x10) != T_FLOAT) {
      x10 = rb_funcall(x10, rb_intern("to_f"), 0);
    }
    if (TYPE(x01) != T_FLOAT) {
      x01 = rb_funcall(x01, rb_intern("to_f"), 0);
    }
    if (TYPE(x11) != T_FLOAT) {
      x11 = rb_funcall(x11, rb_intern("to_f"), 0);
    }
    if (TYPE(y00) != T_FLOAT) {
      y00 = rb_funcall(y00, rb_intern("to_f"), 0);
    }
    if (TYPE(y10) != T_FLOAT) {
      y10 = rb_funcall(y10, rb_intern("to_f"), 0);
    }
    if (TYPE(y01) != T_FLOAT) {
      y01 = rb_funcall(y01, rb_intern("to_f"), 0);
    }
    if (TYPE(y11) != T_FLOAT) {
      y11 = rb_funcall(y11, rb_intern("to_f"), 0);
    }

    i_p = (real)NUM2DBL(p);
    i_q = (real)NUM2DBL(q);
    i_x00 = (real)NUM2DBL(x00);
    i_x10 = (real)NUM2DBL(x10);
    i_x01 = (real)NUM2DBL(x01);
    i_x11 = (real)NUM2DBL(x11);
    i_y00 = (real)NUM2DBL(y00);
    i_y10 = (real)NUM2DBL(y10);
    i_y01 = (real)NUM2DBL(y01);
    i_y11 = (real)NUM2DBL(y11);


    g2fbl2_(&i_p, &i_q, &i_x00, &i_x10, &i_x01, &i_x11, &i_y00, &i_y10, &i_y01, &i_y11, &o_x, &o_y);

    x = rb_float_new((double)o_x);
    y = rb_float_new((double)o_y);


    return rb_ary_new3(2, x, y);

}

static VALUE
dcl_g2ibl2(obj, x, y, x00, x10, x01, x11, y00, y10, y01, y11)
    VALUE obj, x, y, x00, x10, x01, x11, y00, y10, y01, y11;
{
    real i_x;
    real i_y;
    real i_x00;
    real i_x10;
    real i_x01;
    real i_x11;
    real i_y00;
    real i_y10;
    real i_y01;
    real i_y11;
    real o_p;
    real o_q;
    VALUE p;
    VALUE q;

    if (TYPE(x) != T_FLOAT) {
      x = rb_funcall(x, rb_intern("to_f"), 0);
    }
    if (TYPE(y) != T_FLOAT) {
      y = rb_funcall(y, rb_intern("to_f"), 0);
    }
    if (TYPE(x00) != T_FLOAT) {
      x00 = rb_funcall(x00, rb_intern("to_f"), 0);
    }
    if (TYPE(x10) != T_FLOAT) {
      x10 = rb_funcall(x10, rb_intern("to_f"), 0);
    }
    if (TYPE(x01) != T_FLOAT) {
      x01 = rb_funcall(x01, rb_intern("to_f"), 0);
    }
    if (TYPE(x11) != T_FLOAT) {
      x11 = rb_funcall(x11, rb_intern("to_f"), 0);
    }
    if (TYPE(y00) != T_FLOAT) {
      y00 = rb_funcall(y00, rb_intern("to_f"), 0);
    }
    if (TYPE(y10) != T_FLOAT) {
      y10 = rb_funcall(y10, rb_intern("to_f"), 0);
    }
    if (TYPE(y01) != T_FLOAT) {
      y01 = rb_funcall(y01, rb_intern("to_f"), 0);
    }
    if (TYPE(y11) != T_FLOAT) {
      y11 = rb_funcall(y11, rb_intern("to_f"), 0);
    }

    i_x = (real)NUM2DBL(x);
    i_y = (real)NUM2DBL(y);
    i_x00 = (real)NUM2DBL(x00);
    i_x10 = (real)NUM2DBL(x10);
    i_x01 = (real)NUM2DBL(x01);
    i_x11 = (real)NUM2DBL(x11);
    i_y00 = (real)NUM2DBL(y00);
    i_y10 = (real)NUM2DBL(y10);
    i_y01 = (real)NUM2DBL(y01);
    i_y11 = (real)NUM2DBL(y11);


    g2ibl2_(&i_x, &i_y, &i_x00, &i_x10, &i_x01, &i_x11, &i_y00, &i_y10, &i_y01, &i_y11, &o_p, &o_q);

    p = rb_float_new((double)o_p);
    q = rb_float_new((double)o_q);


    return rb_ary_new3(2, p, q);

}

static VALUE
dcl_g2fctr(obj, ux, uy)
    VALUE obj, ux, uy;
{
    real i_ux;
    real i_uy;
    real o_cx;
    real o_cy;
    VALUE cx;
    VALUE cy;

    if (TYPE(ux) != T_FLOAT) {
      ux = rb_funcall(ux, rb_intern("to_f"), 0);
    }
    if (TYPE(uy) != T_FLOAT) {
      uy = rb_funcall(uy, rb_intern("to_f"), 0);
    }

    i_ux = (real)NUM2DBL(ux);
    i_uy = (real)NUM2DBL(uy);


    g2fctr_(&i_ux, &i_uy, &o_cx, &o_cy);

    cx = rb_float_new((double)o_cx);
    cy = rb_float_new((double)o_cy);


    return rb_ary_new3(2, cx, cy);

}

static VALUE
dcl_g2ictr(obj, cx, cy)
    VALUE obj, cx, cy;
{
    real i_cx;
    real i_cy;
    real o_ux;
    real o_uy;
    VALUE ux;
    VALUE uy;

    if (TYPE(cx) != T_FLOAT) {
      cx = rb_funcall(cx, rb_intern("to_f"), 0);
    }
    if (TYPE(cy) != T_FLOAT) {
      cy = rb_funcall(cy, rb_intern("to_f"), 0);
    }

    i_cx = (real)NUM2DBL(cx);
    i_cy = (real)NUM2DBL(cy);


    g2ictr_(&i_cx, &i_cy, &o_ux, &o_uy);

    ux = rb_float_new((double)o_ux);
    uy = rb_float_new((double)o_uy);


    return rb_ary_new3(2, ux, uy);

}

static VALUE
dcl_g2qcti(obj)
    VALUE obj;
{
    logical o_lini;
    VALUE lini;

    g2qcti_(&o_lini);

    lini = (o_lini == FALSE_) ? Qfalse : Qtrue;


    return lini;

}

static VALUE
dcl_g2qctm(obj)
    VALUE obj;
{
    real o_cxmine;
    real o_cxmaxe;
    real o_cymine;
    real o_cymaxe;
    VALUE cxmine;
    VALUE cxmaxe;
    VALUE cymine;
    VALUE cymaxe;

    g2qctm_(&o_cxmine, &o_cxmaxe, &o_cymine, &o_cymaxe);

    cxmine = rb_float_new((double)o_cxmine);
    cxmaxe = rb_float_new((double)o_cxmaxe);
    cymine = rb_float_new((double)o_cymine);
    cymaxe = rb_float_new((double)o_cymaxe);


    return rb_ary_new3(4, cxmine, cxmaxe, cymine, cymaxe);

}

static VALUE
dcl_g2sctr(obj, nx, ny, uxa, uya, cxa, cya)
    VALUE obj, nx, ny, uxa, uya, cxa, cya;
{
    integer i_nx;
    integer i_ny;
    real *i_uxa;
    real *i_uya;
    real *i_cxa;
    real *i_cya;

    if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) {
      nx = rb_funcall(nx, rb_intern("to_i"), 0);
    }
    if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) {
      ny = rb_funcall(ny, rb_intern("to_i"), 0);
    }
    if (TYPE(uxa) == T_FLOAT) {
      uxa = rb_Array(uxa);
    }
    /* if ((TYPE(uxa) != T_ARRAY) && 
           (rb_obj_is_kind_of(uxa, cNArray) != Qtrue)) {
         rb_raise(rb_eTypeError, "invalid type");
       }  -- no check since obj2c*ary will do that */
    if (TYPE(uya) == T_FLOAT) {
      uya = rb_Array(uya);
    }
    /* if ((TYPE(uya) != T_ARRAY) && 
           (rb_obj_is_kind_of(uya, cNArray) != Qtrue)) {
         rb_raise(rb_eTypeError, "invalid type");
       }  -- no check since obj2c*ary will do that */
    if (TYPE(cxa) == T_FLOAT) {
      cxa = rb_Array(cxa);
    }
    /* if ((TYPE(cxa) != T_ARRAY) && 
           (rb_obj_is_kind_of(cxa, cNArray) != Qtrue)) {
         rb_raise(rb_eTypeError, "invalid type");
       }  -- no check since obj2c*ary will do that */
    if (TYPE(cya) == T_FLOAT) {
      cya = rb_Array(cya);
    }
    /* if ((TYPE(cya) != T_ARRAY) && 
           (rb_obj_is_kind_of(cya, cNArray) != Qtrue)) {
         rb_raise(rb_eTypeError, "invalid type");
       }  -- no check since obj2c*ary will do that */

    i_nx = NUM2INT(nx);
    i_ny = NUM2INT(ny);
    i_uxa = dcl_obj2crealary(uxa);
    i_uya = dcl_obj2crealary(uya);
    i_cxa = dcl_obj2crealary(cxa);
    i_cya = dcl_obj2crealary(cya);


    g2sctr_(&i_nx, &i_ny, i_uxa, i_uya, i_cxa, i_cya);

    dcl_freecrealary(i_uxa);
    dcl_freecrealary(i_uya);
    dcl_freecrealary(i_cxa);
    dcl_freecrealary(i_cya);

    return Qnil;

}

static VALUE
dcl_lg2inq(obj, cx, cy, cx00, cx10, cx01, cx11, cy00, cy10, cy01, cy11)
    VALUE obj, cx, cy, cx00, cx10, cx01, cx11, cy00, cy10, cy01, cy11;
{
    real i_cx;
    real i_cy;
    real i_cx00;
    real i_cx10;
    real i_cx01;
    real i_cx11;
    real i_cy00;
    real i_cy10;
    real i_cy01;
    real i_cy11;
    logical o_rtn_val;
    VALUE rtn_val;

    if (TYPE(cx) != T_FLOAT) {
      cx = rb_funcall(cx, rb_intern("to_f"), 0);
    }
    if (TYPE(cy) != T_FLOAT) {
      cy = rb_funcall(cy, rb_intern("to_f"), 0);
    }
    if (TYPE(cx00) != T_FLOAT) {
      cx00 = rb_funcall(cx00, rb_intern("to_f"), 0);
    }
    if (TYPE(cx10) != T_FLOAT) {
      cx10 = rb_funcall(cx10, rb_intern("to_f"), 0);
    }
    if (TYPE(cx01) != T_FLOAT) {
      cx01 = rb_funcall(cx01, rb_intern("to_f"), 0);
    }
    if (TYPE(cx11) != T_FLOAT) {
      cx11 = rb_funcall(cx11, rb_intern("to_f"), 0);
    }
    if (TYPE(cy00) != T_FLOAT) {
      cy00 = rb_funcall(cy00, rb_intern("to_f"), 0);
    }
    if (TYPE(cy10) != T_FLOAT) {
      cy10 = rb_funcall(cy10, rb_intern("to_f"), 0);
    }
    if (TYPE(cy01) != T_FLOAT) {
      cy01 = rb_funcall(cy01, rb_intern("to_f"), 0);
    }
    if (TYPE(cy11) != T_FLOAT) {
      cy11 = rb_funcall(cy11, rb_intern("to_f"), 0);
    }

    i_cx = (real)NUM2DBL(cx);
    i_cy = (real)NUM2DBL(cy);
    i_cx00 = (real)NUM2DBL(cx00);
    i_cx10 = (real)NUM2DBL(cx10);
    i_cx01 = (real)NUM2DBL(cx01);
    i_cx11 = (real)NUM2DBL(cx11);
    i_cy00 = (real)NUM2DBL(cy00);
    i_cy10 = (real)NUM2DBL(cy10);
    i_cy01 = (real)NUM2DBL(cy01);
    i_cy11 = (real)NUM2DBL(cy11);


    o_rtn_val = lg2inq_(&i_cx, &i_cy, &i_cx00, &i_cx10, &i_cx01, &i_cx11, &i_cy00, &i_cy10, &i_cy01, &i_cy11);

    rtn_val = (o_rtn_val == FALSE_) ? Qfalse : Qtrue;


    return rtn_val;

}

#endif
void
init_math1_gt2dlib(mDCL)
VALUE mDCL;
{
#if DCLVER >= 53
    rb_define_module_function(mDCL, "g2fbli", dcl_g2fbli, 6);
    rb_define_module_function(mDCL, "g2fbl2", dcl_g2fbl2, 10);
    rb_define_module_function(mDCL, "g2ibl2", dcl_g2ibl2, 10);
    rb_define_module_function(mDCL, "g2fctr", dcl_g2fctr, 2);
    rb_define_module_function(mDCL, "g2ictr", dcl_g2ictr, 2);
    rb_define_module_function(mDCL, "g2qcti", dcl_g2qcti, 0);
    rb_define_module_function(mDCL, "g2qctm", dcl_g2qctm, 0);
    rb_define_module_function(mDCL, "g2sctr", dcl_g2sctr, 6);
    rb_define_module_function(mDCL, "lg2inq", dcl_lg2inq, 10);
#endif
}