/*
 * $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;

static VALUE
dcl_uwsgxa(obj, xp, nx)
    VALUE obj, xp, nx;
{
    real *i_xp;
    integer i_nx;

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

    i_nx = NUM2INT(nx);
    i_xp = dcl_obj2crealary(xp);


    uwsgxa_(i_xp, &i_nx);

    dcl_freecrealary(i_xp);

    return Qnil;

}

static VALUE
dcl_uwqgxa(obj)
    VALUE obj;
{
    real *o_xp;
    integer o_nx;
    VALUE xp;
    VALUE nx;

    o_xp= ALLOCA_N(real, (o_nx));

    uwqgxa_(o_xp, &o_nx);

    {int array_shape[1] = {o_nx};
     xp = dcl_crealary2obj(o_xp, (o_nx), 1, array_shape);
    }
    nx = INT2NUM(o_nx);


    return rb_ary_new3(2, xp, nx);

}

static VALUE
dcl_uwsgxb(obj, uxmin, uxmax, nx)
    VALUE obj, uxmin, uxmax, nx;
{
    real i_uxmin;
    real i_uxmax;
    integer i_nx;

    if (TYPE(uxmin) != T_FLOAT) {
      uxmin = rb_funcall(uxmin, rb_intern("to_f"), 0);
    }
    if (TYPE(uxmax) != T_FLOAT) {
      uxmax = rb_funcall(uxmax, rb_intern("to_f"), 0);
    }
    if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) {
      nx = rb_funcall(nx, rb_intern("to_i"), 0);
    }

    i_uxmin = (real)NUM2DBL(uxmin);
    i_uxmax = (real)NUM2DBL(uxmax);
    i_nx = NUM2INT(nx);


    uwsgxb_(&i_uxmin, &i_uxmax, &i_nx);

    return Qnil;

}

static VALUE
dcl_uwqgxb(obj)
    VALUE obj;
{
    real o_uxmin;
    real o_uxmax;
    integer o_nx;
    VALUE uxmin;
    VALUE uxmax;
    VALUE nx;

    uwqgxb_(&o_uxmin, &o_uxmax, &o_nx);

    uxmin = rb_float_new((double)o_uxmin);
    uxmax = rb_float_new((double)o_uxmax);
    nx = INT2NUM(o_nx);


    return rb_ary_new3(3, uxmin, uxmax, nx);

}

static VALUE
dcl_uwsgxz(obj, lsetx)
    VALUE obj, lsetx;
{
    logical i_lsetx;

    i_lsetx = ((lsetx == Qnil)||(lsetx == Qfalse)) ? FALSE_ : TRUE_;


    uwsgxz_(&i_lsetx);

    return Qnil;

}

static VALUE
dcl_uwqgxz(obj)
    VALUE obj;
{
    logical o_lsetx;
    VALUE lsetx;

    uwqgxz_(&o_lsetx);

    lsetx = (o_lsetx == FALSE_) ? Qfalse : Qtrue;


    return lsetx;

}

static VALUE
dcl_uwsgya(obj, yp, ny)
    VALUE obj, yp, ny;
{
    real *i_yp;
    integer i_ny;

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

    i_ny = NUM2INT(ny);
    i_yp = dcl_obj2crealary(yp);


    uwsgya_(i_yp, &i_ny);

    dcl_freecrealary(i_yp);

    return Qnil;

}

static VALUE
dcl_uwqgya(obj)
    VALUE obj;
{
    real *o_yp;
    integer o_ny;
    VALUE yp;
    VALUE ny;

    o_yp= ALLOCA_N(real, (o_ny));

    uwqgya_(o_yp, &o_ny);

    {int array_shape[1] = {o_ny};
     yp = dcl_crealary2obj(o_yp, (o_ny), 1, array_shape);
    }
    ny = INT2NUM(o_ny);


    return rb_ary_new3(2, yp, ny);

}

static VALUE
dcl_uwsgyb(obj, uymin, uymax, ny)
    VALUE obj, uymin, uymax, ny;
{
    real i_uymin;
    real i_uymax;
    integer i_ny;

    if (TYPE(uymin) != T_FLOAT) {
      uymin = rb_funcall(uymin, rb_intern("to_f"), 0);
    }
    if (TYPE(uymax) != T_FLOAT) {
      uymax = rb_funcall(uymax, rb_intern("to_f"), 0);
    }
    if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) {
      ny = rb_funcall(ny, rb_intern("to_i"), 0);
    }

    i_uymin = (real)NUM2DBL(uymin);
    i_uymax = (real)NUM2DBL(uymax);
    i_ny = NUM2INT(ny);


    uwsgyb_(&i_uymin, &i_uymax, &i_ny);

    return Qnil;

}

static VALUE
dcl_uwqgyb(obj)
    VALUE obj;
{
    real o_uymin;
    real o_uymax;
    integer o_ny;
    VALUE uymin;
    VALUE uymax;
    VALUE ny;

    uwqgyb_(&o_uymin, &o_uymax, &o_ny);

    uymin = rb_float_new((double)o_uymin);
    uymax = rb_float_new((double)o_uymax);
    ny = INT2NUM(o_ny);


    return rb_ary_new3(3, uymin, uymax, ny);

}

static VALUE
dcl_uwsgyz(obj, lsety)
    VALUE obj, lsety;
{
    logical i_lsety;

    i_lsety = ((lsety == Qnil)||(lsety == Qfalse)) ? FALSE_ : TRUE_;


    uwsgyz_(&i_lsety);

    return Qnil;

}

static VALUE
dcl_uwqgyz(obj)
    VALUE obj;
{
    logical o_lsety;
    VALUE lsety;

    uwqgyz_(&o_lsety);

    lsety = (o_lsety == FALSE_) ? Qfalse : Qtrue;


    return lsety;

}

static VALUE
dcl_uwqgxi(obj, ux)
    VALUE obj, ux;
{
    real i_ux;
    integer o_iux;
    real o_frac;
    VALUE iux;
    VALUE frac;

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

    i_ux = (real)NUM2DBL(ux);


    uwqgxi_(&i_ux, &o_iux, &o_frac);

    iux = INT2NUM(o_iux);
    frac = rb_float_new((double)o_frac);


    return rb_ary_new3(2, iux, frac);

}

static VALUE
dcl_uwigxi(obj)
    VALUE obj;
{
    uwigxi_();

    return Qnil;

}

static VALUE
dcl_uwqgyi(obj, uy)
    VALUE obj, uy;
{
    real i_uy;
    integer o_iuy;
    real o_frac;
    VALUE iuy;
    VALUE frac;

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

    i_uy = (real)NUM2DBL(uy);


    uwqgyi_(&i_uy, &o_iuy, &o_frac);

    iuy = INT2NUM(o_iuy);
    frac = rb_float_new((double)o_frac);


    return rb_ary_new3(2, iuy, frac);

}

static VALUE
dcl_uwigyi(obj)
    VALUE obj;
{
    uwigyi_();

    return Qnil;

}

static VALUE
dcl_ruwgx(obj, ix)
    VALUE obj, ix;
{
    integer i_ix;
    real o_rtn_val;
    VALUE rtn_val;

    if ((TYPE(ix) != T_BIGNUM) || (TYPE(ix) != T_FIXNUM)) {
      ix = rb_funcall(ix, rb_intern("to_i"), 0);
    }

    i_ix = NUM2INT(ix);


    o_rtn_val = ruwgx_(&i_ix);

    rtn_val = rb_float_new((double)o_rtn_val);


    return rtn_val;

}

static VALUE
dcl_ruwgy(obj, iy)
    VALUE obj, iy;
{
    integer i_iy;
    real o_rtn_val;
    VALUE rtn_val;

    if ((TYPE(iy) != T_BIGNUM) || (TYPE(iy) != T_FIXNUM)) {
      iy = rb_funcall(iy, rb_intern("to_i"), 0);
    }

    i_iy = NUM2INT(iy);


    o_rtn_val = ruwgy_(&i_iy);

    rtn_val = rb_float_new((double)o_rtn_val);


    return rtn_val;

}

static VALUE
dcl_iuwgx(obj, ux)
    VALUE obj, ux;
{
    real i_ux;
    integer o_rtn_val;
    VALUE rtn_val;

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

    i_ux = (real)NUM2DBL(ux);


    o_rtn_val = iuwgx_(&i_ux);

    rtn_val = INT2NUM(o_rtn_val);


    return rtn_val;

}

static VALUE
dcl_iuwgy(obj, uy)
    VALUE obj, uy;
{
    real i_uy;
    integer o_rtn_val;
    VALUE rtn_val;

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

    i_uy = (real)NUM2DBL(uy);


    o_rtn_val = iuwgy_(&i_uy);

    rtn_val = INT2NUM(o_rtn_val);


    return rtn_val;

}

static VALUE
dcl_uwdflt(obj, nx, ny)
    VALUE obj, nx, ny;
{
    integer i_nx;
    integer i_ny;

    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);
    }

    i_nx = NUM2INT(nx);
    i_ny = NUM2INT(ny);


    uwdflt_(&i_nx, &i_ny);

    return Qnil;

}
void
init_grph2_uwpack(mDCL)
VALUE mDCL;
{
    rb_define_module_function(mDCL, "uwsgxa", dcl_uwsgxa, 2);
    rb_define_module_function(mDCL, "uwqgxa", dcl_uwqgxa, 0);
    rb_define_module_function(mDCL, "uwsgxb", dcl_uwsgxb, 3);
    rb_define_module_function(mDCL, "uwqgxb", dcl_uwqgxb, 0);
    rb_define_module_function(mDCL, "uwsgxz", dcl_uwsgxz, 1);
    rb_define_module_function(mDCL, "uwqgxz", dcl_uwqgxz, 0);
    rb_define_module_function(mDCL, "uwsgya", dcl_uwsgya, 2);
    rb_define_module_function(mDCL, "uwqgya", dcl_uwqgya, 0);
    rb_define_module_function(mDCL, "uwsgyb", dcl_uwsgyb, 3);
    rb_define_module_function(mDCL, "uwqgyb", dcl_uwqgyb, 0);
    rb_define_module_function(mDCL, "uwsgyz", dcl_uwsgyz, 1);
    rb_define_module_function(mDCL, "uwqgyz", dcl_uwqgyz, 0);
    rb_define_module_function(mDCL, "uwqgxi", dcl_uwqgxi, 1);
    rb_define_module_function(mDCL, "uwigxi", dcl_uwigxi, 0);
    rb_define_module_function(mDCL, "uwqgyi", dcl_uwqgyi, 1);
    rb_define_module_function(mDCL, "uwigyi", dcl_uwigyi, 0);
    rb_define_module_function(mDCL, "ruwgx", dcl_ruwgx, 1);
    rb_define_module_function(mDCL, "ruwgy", dcl_ruwgy, 1);
    rb_define_module_function(mDCL, "iuwgx", dcl_iuwgx, 1);
    rb_define_module_function(mDCL, "iuwgy", dcl_iuwgy, 1);
    rb_define_module_function(mDCL, "uwdflt", dcl_uwdflt, 2);
}