/*
 * $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_udcntr(obj, z, mx, nx, ny)
    VALUE obj, z, mx, nx, ny;
{
    real *i_z;
    integer i_mx;
    integer i_nx;
    integer i_ny;

    if (TYPE(z) == T_FLOAT) {
      z = rb_Array(z);
    }
    /* if ((TYPE(z) != T_ARRAY) && 
           (rb_obj_is_kind_of(z, cNArray) != Qtrue)) {
         rb_raise(rb_eTypeError, "invalid type");
       }  -- no check since obj2c*ary will do that */
    if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) {
      mx = rb_funcall(mx, rb_intern("to_i"), 0);
    }
    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_mx = NUM2INT(mx);
    i_nx = NUM2INT(nx);
    i_ny = NUM2INT(ny);
    i_z = dcl_obj2crealary(z);


    udcntr_(i_z, &i_mx, &i_nx, &i_ny);

    dcl_freecrealary(i_z);

    return Qnil;

}

static VALUE
dcl_udcntz(obj, z, mx, nx, ny, nbr2)
    VALUE obj, z, mx, nx, ny, nbr2;
{
    real *i_z;
    integer i_mx;
    integer i_nx;
    integer i_ny;
    integer *w_ibr;
    integer i_nbr2;

    if (TYPE(z) == T_FLOAT) {
      z = rb_Array(z);
    }
    /* if ((TYPE(z) != T_ARRAY) && 
           (rb_obj_is_kind_of(z, cNArray) != Qtrue)) {
         rb_raise(rb_eTypeError, "invalid type");
       }  -- no check since obj2c*ary will do that */
    if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) {
      mx = rb_funcall(mx, rb_intern("to_i"), 0);
    }
    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(nbr2) != T_BIGNUM) || (TYPE(nbr2) != T_FIXNUM)) {
      nbr2 = rb_funcall(nbr2, rb_intern("to_i"), 0);
    }

    i_mx = NUM2INT(mx);
    i_nx = NUM2INT(nx);
    i_ny = NUM2INT(ny);
    i_nbr2 = NUM2INT(nbr2);
    i_z = dcl_obj2crealary(z);

    w_ibr= ALLOCA_N(integer, (i_nbr2));

    udcntz_(i_z, &i_mx, &i_nx, &i_ny, w_ibr, &i_nbr2);

    dcl_freecrealary(i_z);

    return Qnil;

}

static VALUE
dcl_udgcla(obj, xmin, xmax, dx)
    VALUE obj, xmin, xmax, dx;
{
    real i_xmin;
    real i_xmax;
    real i_dx;

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

    i_xmin = (real)NUM2DBL(xmin);
    i_xmax = (real)NUM2DBL(xmax);
    i_dx = (real)NUM2DBL(dx);


    udgcla_(&i_xmin, &i_xmax, &i_dx);

    return Qnil;

}

static VALUE
dcl_udgclb(obj, z, mx, nx, ny, dx)
    VALUE obj, z, mx, nx, ny, dx;
{
    real *i_z;
    integer i_mx;
    integer i_nx;
    integer i_ny;
    real i_dx;

    if (TYPE(z) == T_FLOAT) {
      z = rb_Array(z);
    }
    /* if ((TYPE(z) != T_ARRAY) && 
           (rb_obj_is_kind_of(z, cNArray) != Qtrue)) {
         rb_raise(rb_eTypeError, "invalid type");
       }  -- no check since obj2c*ary will do that */
    if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) {
      mx = rb_funcall(mx, rb_intern("to_i"), 0);
    }
    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(dx) != T_FLOAT) {
      dx = rb_funcall(dx, rb_intern("to_f"), 0);
    }

    i_mx = NUM2INT(mx);
    i_nx = NUM2INT(nx);
    i_ny = NUM2INT(ny);
    i_dx = (real)NUM2DBL(dx);
    i_z = dcl_obj2crealary(z);


    udgclb_(i_z, &i_mx, &i_nx, &i_ny, &i_dx);

    dcl_freecrealary(i_z);

    return Qnil;

}

static VALUE
dcl_udiclv(obj)
    VALUE obj;
{
    udiclv_();

    return Qnil;

}

static VALUE
dcl_udsclv(obj, zlev, indx, ityp, clv, hl)
    VALUE obj, zlev, indx, ityp, clv, hl;
{
    real i_zlev;
    integer i_indx;
    integer i_ityp;
    char *i_clv;
    real i_hl;

    if (TYPE(zlev) != T_FLOAT) {
      zlev = rb_funcall(zlev, rb_intern("to_f"), 0);
    }
    if ((TYPE(indx) != T_BIGNUM) || (TYPE(indx) != T_FIXNUM)) {
      indx = rb_funcall(indx, rb_intern("to_i"), 0);
    }
    if ((TYPE(ityp) != T_BIGNUM) || (TYPE(ityp) != T_FIXNUM)) {
      ityp = rb_funcall(ityp, rb_intern("to_i"), 0);
    }
    if (TYPE(clv) != T_STRING) {
      clv = rb_funcall(clv, rb_intern("to_str"), 0);
    }
    if (TYPE(hl) != T_FLOAT) {
      hl = rb_funcall(hl, rb_intern("to_f"), 0);
    }

    i_zlev = (real)NUM2DBL(zlev);
    i_indx = NUM2INT(indx);
    i_ityp = NUM2INT(ityp);
    i_clv = STR2CSTR(clv);
    i_hl = (real)NUM2DBL(hl);


    udsclv_(&i_zlev, &i_indx, &i_ityp, i_clv, &i_hl, (ftnlen)strlen(i_clv));

    return Qnil;

}

static VALUE
dcl_udqclv(obj, nlev)
    VALUE obj, nlev;
{
    real o_zlev;
    integer o_indx;
    integer o_ityp;
    char *o_clv;
    real o_hl;
    integer i_nlev;
    VALUE zlev;
    VALUE indx;
    VALUE ityp;
    VALUE clv;
    VALUE hl;

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

    i_nlev = NUM2INT(nlev);

    o_clv= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_clv, '\0', DFLT_SIZE+1);

    udqclv_(&o_zlev, &o_indx, &o_ityp, o_clv, &o_hl, &i_nlev, (ftnlen)DFLT_SIZE);

    zlev = rb_float_new((double)o_zlev);
    indx = INT2NUM(o_indx);
    ityp = INT2NUM(o_ityp);
    clv = rb_str_new2(o_clv);
    hl = rb_float_new((double)o_hl);


    return rb_ary_new3(5, zlev, indx, ityp, clv, hl);

}

static VALUE
dcl_udqcln(obj)
    VALUE obj;
{
    integer o_nlev;
    VALUE nlev;

    udqcln_(&o_nlev);

    nlev = INT2NUM(o_nlev);


    return nlev;

}

static VALUE
dcl_uddclv(obj, zlev)
    VALUE obj, zlev;
{
    real i_zlev;

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

    i_zlev = (real)NUM2DBL(zlev);


    uddclv_(&i_zlev);

    return Qnil;

}

static VALUE
dcl_rudlev(obj, nlev)
    VALUE obj, nlev;
{
    integer i_nlev;
    real o_rtn_val;
    VALUE rtn_val;

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

    i_nlev = NUM2INT(nlev);


    o_rtn_val = rudlev_(&i_nlev);

    rtn_val = rb_float_new((double)o_rtn_val);


    return rtn_val;

}

static VALUE
dcl_udiclr(obj, n)
    VALUE obj, n;
{
    integer *o_ix;
    integer i_n;
    VALUE ix;

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

    i_n = NUM2INT(n);

    o_ix= ALLOCA_N(integer, (i_n));

    udiclr_(o_ix, &i_n);

    {int array_shape[1] = {i_n};
     ix = dcl_cintegerary2obj(o_ix, (i_n), 1, array_shape);
    }


    return ix;

}

static VALUE
dcl_udlabl(obj, val)
    VALUE obj, val;
{
    real i_val;
    char *o_cval;
    VALUE cval;

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

    i_val = (real)NUM2DBL(val);

    o_cval= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cval, '\0', DFLT_SIZE+1);

    udlabl_(&i_val, o_cval, (ftnlen)DFLT_SIZE);

    cval = rb_str_new2(o_cval);


    return cval;

}

static VALUE
dcl_udsfmt(obj, cfmt)
    VALUE obj, cfmt;
{
    char *i_cfmt;

    if (TYPE(cfmt) != T_STRING) {
      cfmt = rb_funcall(cfmt, rb_intern("to_str"), 0);
    }

    i_cfmt = STR2CSTR(cfmt);


    udsfmt_(i_cfmt, (ftnlen)strlen(i_cfmt));

    return Qnil;

}

static VALUE
dcl_udqfmt(obj)
    VALUE obj;
{
    char *o_cfmt;
    VALUE cfmt;

    o_cfmt= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cfmt, '\0', DFLT_SIZE+1);

    udqfmt_(o_cfmt, (ftnlen)DFLT_SIZE);

    cfmt = rb_str_new2(o_cfmt);


    return cfmt;

}

static VALUE
dcl_udpqnp(obj)
    VALUE obj;
{
    integer o_ncp;
    VALUE ncp;

    udpqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_udpqid(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_idx;
    VALUE idx;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udpqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_udpqcp(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udpqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udpqcl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udpqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udpqit(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    integer o_itp;
    VALUE itp;

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

    i_idx = NUM2INT(idx);


    udpqit_(&i_idx, &o_itp);

    itp = INT2NUM(o_itp);


    return itp;

}

static VALUE
dcl_udpqvl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    integer o_ipara;
    VALUE ipara;

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

    i_idx = NUM2INT(idx);


    udpqvl_(&i_idx, &o_ipara);

    ipara = INT2NUM(o_ipara);


    return ipara;

}

static VALUE
dcl_udpsvl(obj, idx, ipara)
    VALUE obj, idx, ipara;
{
    integer i_idx;
    integer i_ipara;

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

    i_idx = NUM2INT(idx);
    i_ipara = NUM2INT(ipara);


    udpsvl_(&i_idx, &i_ipara);

    return Qnil;

}

static VALUE
dcl_udpqin(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_in;
    VALUE in;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udpqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));

    in = INT2NUM(o_in);


    return in;

}

static VALUE
dcl_udiget(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_ipara;
    VALUE ipara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp));

    ipara = INT2NUM(o_ipara);


    return ipara;

}

static VALUE
dcl_udiset(obj, cp, ipara)
    VALUE obj, cp, ipara;
{
    char *i_cp;
    integer i_ipara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }
    if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
      ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
    }

    i_cp = STR2CSTR(cp);
    i_ipara = NUM2INT(ipara);


    udiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));

    return Qnil;

}

static VALUE
dcl_udistx(obj, cp, ipara)
    VALUE obj, cp, ipara;
{
    char *i_cp;
    integer i_ipara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }
    if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
      ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
    }

    i_cp = STR2CSTR(cp);
    i_ipara = NUM2INT(ipara);


    udistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));

    return Qnil;

}

static VALUE
dcl_udiqnp(obj)
    VALUE obj;
{
    integer o_ncp;
    VALUE ncp;

    udiqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_udiqid(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_idx;
    VALUE idx;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_udiqcp(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udiqcl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udiqvl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    integer o_ipara;
    VALUE ipara;

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

    i_idx = NUM2INT(idx);


    udiqvl_(&i_idx, &o_ipara);

    ipara = INT2NUM(o_ipara);


    return ipara;

}

static VALUE
dcl_udisvl(obj, idx, ipara)
    VALUE obj, idx, ipara;
{
    integer i_idx;
    integer i_ipara;

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

    i_idx = NUM2INT(idx);
    i_ipara = NUM2INT(ipara);


    udisvl_(&i_idx, &i_ipara);

    return Qnil;

}

static VALUE
dcl_udiqin(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_in;
    VALUE in;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));

    in = INT2NUM(o_in);


    return in;

}

static VALUE
dcl_udlget(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    logical o_lpara;
    VALUE lpara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udlget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp));

    lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;


    return lpara;

}

static VALUE
dcl_udlset(obj, cp, lpara)
    VALUE obj, cp, lpara;
{
    char *i_cp;
    logical i_lpara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);
    i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;


    udlset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));

    return Qnil;

}

static VALUE
dcl_udlstx(obj, cp, lpara)
    VALUE obj, cp, lpara;
{
    char *i_cp;
    logical i_lpara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);
    i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;


    udlstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));

    return Qnil;

}

static VALUE
dcl_udlqnp(obj)
    VALUE obj;
{
    integer o_ncp;
    VALUE ncp;

    udlqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_udlqid(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_idx;
    VALUE idx;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udlqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_udlqcp(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udlqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udlqcl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udlqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udlqvl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    logical o_lpara;
    VALUE lpara;

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

    i_idx = NUM2INT(idx);


    udlqvl_(&i_idx, &o_lpara);

    lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;


    return lpara;

}

static VALUE
dcl_udlsvl(obj, idx, lpara)
    VALUE obj, idx, lpara;
{
    integer i_idx;
    logical i_lpara;

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

    i_idx = NUM2INT(idx);
    i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;


    udlsvl_(&i_idx, &i_lpara);

    return Qnil;

}

static VALUE
dcl_udlqin(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_in;
    VALUE in;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udlqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));

    in = INT2NUM(o_in);


    return in;

}

static VALUE
dcl_udrget(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    real o_rpara;
    VALUE rpara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp));

    rpara = rb_float_new((double)o_rpara);


    return rpara;

}

static VALUE
dcl_udrset(obj, cp, rpara)
    VALUE obj, cp, rpara;
{
    char *i_cp;
    real i_rpara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }
    if (TYPE(rpara) != T_FLOAT) {
      rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
    }

    i_cp = STR2CSTR(cp);
    i_rpara = (real)NUM2DBL(rpara);


    udrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));

    return Qnil;

}

static VALUE
dcl_udrstx(obj, cp, rpara)
    VALUE obj, cp, rpara;
{
    char *i_cp;
    real i_rpara;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }
    if (TYPE(rpara) != T_FLOAT) {
      rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
    }

    i_cp = STR2CSTR(cp);
    i_rpara = (real)NUM2DBL(rpara);


    udrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));

    return Qnil;

}

static VALUE
dcl_udrqnp(obj)
    VALUE obj;
{
    integer o_ncp;
    VALUE ncp;

    udrqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_udrqid(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_idx;
    VALUE idx;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_udrqcp(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udrqcl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    char *o_cp;
    VALUE cp;

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

    i_idx = NUM2INT(idx);

    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
    memset(o_cp, '\0', DFLT_SIZE+1);

    udrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_udrqvl(obj, idx)
    VALUE obj, idx;
{
    integer i_idx;
    real o_rpara;
    VALUE rpara;

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

    i_idx = NUM2INT(idx);


    udrqvl_(&i_idx, &o_rpara);

    rpara = rb_float_new((double)o_rpara);


    return rpara;

}

static VALUE
dcl_udrsvl(obj, idx, rpara)
    VALUE obj, idx, rpara;
{
    integer i_idx;
    real i_rpara;

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

    i_idx = NUM2INT(idx);
    i_rpara = (real)NUM2DBL(rpara);


    udrsvl_(&i_idx, &i_rpara);

    return Qnil;

}

static VALUE
dcl_udrqin(obj, cp)
    VALUE obj, cp;
{
    char *i_cp;
    integer o_in;
    VALUE in;

    if (TYPE(cp) != T_STRING) {
      cp = rb_funcall(cp, rb_intern("to_str"), 0);
    }

    i_cp = STR2CSTR(cp);


    udrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));

    in = INT2NUM(o_in);


    return in;

}
void
init_grph2_udpack(mDCL)
VALUE mDCL;
{
    rb_define_module_function(mDCL, "udcntr", dcl_udcntr, 4);
    rb_define_module_function(mDCL, "udcntz", dcl_udcntz, 5);
    rb_define_module_function(mDCL, "udgcla", dcl_udgcla, 3);
    rb_define_module_function(mDCL, "udgclb", dcl_udgclb, 5);
    rb_define_module_function(mDCL, "udiclv", dcl_udiclv, 0);
    rb_define_module_function(mDCL, "udsclv", dcl_udsclv, 5);
    rb_define_module_function(mDCL, "udqclv", dcl_udqclv, 1);
    rb_define_module_function(mDCL, "udqcln", dcl_udqcln, 0);
    rb_define_module_function(mDCL, "uddclv", dcl_uddclv, 1);
    rb_define_module_function(mDCL, "rudlev", dcl_rudlev, 1);
    rb_define_module_function(mDCL, "udiclr", dcl_udiclr, 1);
    rb_define_module_function(mDCL, "udlabl", dcl_udlabl, 1);
    rb_define_module_function(mDCL, "udsfmt", dcl_udsfmt, 1);
    rb_define_module_function(mDCL, "udqfmt", dcl_udqfmt, 0);
    rb_define_module_function(mDCL, "udpqnp", dcl_udpqnp, 0);
    rb_define_module_function(mDCL, "udpqid", dcl_udpqid, 1);
    rb_define_module_function(mDCL, "udpqcp", dcl_udpqcp, 1);
    rb_define_module_function(mDCL, "udpqcl", dcl_udpqcl, 1);
    rb_define_module_function(mDCL, "udpqit", dcl_udpqit, 1);
    rb_define_module_function(mDCL, "udpqvl", dcl_udpqvl, 1);
    rb_define_module_function(mDCL, "udpsvl", dcl_udpsvl, 2);
    rb_define_module_function(mDCL, "udpqin", dcl_udpqin, 1);
    rb_define_module_function(mDCL, "udiget", dcl_udiget, 1);
    rb_define_module_function(mDCL, "udiset", dcl_udiset, 2);
    rb_define_module_function(mDCL, "udistx", dcl_udistx, 2);
    rb_define_module_function(mDCL, "udiqnp", dcl_udiqnp, 0);
    rb_define_module_function(mDCL, "udiqid", dcl_udiqid, 1);
    rb_define_module_function(mDCL, "udiqcp", dcl_udiqcp, 1);
    rb_define_module_function(mDCL, "udiqcl", dcl_udiqcl, 1);
    rb_define_module_function(mDCL, "udiqvl", dcl_udiqvl, 1);
    rb_define_module_function(mDCL, "udisvl", dcl_udisvl, 2);
    rb_define_module_function(mDCL, "udiqin", dcl_udiqin, 1);
    rb_define_module_function(mDCL, "udlget", dcl_udlget, 1);
    rb_define_module_function(mDCL, "udlset", dcl_udlset, 2);
    rb_define_module_function(mDCL, "udlstx", dcl_udlstx, 2);
    rb_define_module_function(mDCL, "udlqnp", dcl_udlqnp, 0);
    rb_define_module_function(mDCL, "udlqid", dcl_udlqid, 1);
    rb_define_module_function(mDCL, "udlqcp", dcl_udlqcp, 1);
    rb_define_module_function(mDCL, "udlqcl", dcl_udlqcl, 1);
    rb_define_module_function(mDCL, "udlqvl", dcl_udlqvl, 1);
    rb_define_module_function(mDCL, "udlsvl", dcl_udlsvl, 2);
    rb_define_module_function(mDCL, "udlqin", dcl_udlqin, 1);
    rb_define_module_function(mDCL, "udrget", dcl_udrget, 1);
    rb_define_module_function(mDCL, "udrset", dcl_udrset, 2);
    rb_define_module_function(mDCL, "udrstx", dcl_udrstx, 2);
    rb_define_module_function(mDCL, "udrqnp", dcl_udrqnp, 0);
    rb_define_module_function(mDCL, "udrqid", dcl_udrqid, 1);
    rb_define_module_function(mDCL, "udrqcp", dcl_udrqcp, 1);
    rb_define_module_function(mDCL, "udrqcl", dcl_udrqcl, 1);
    rb_define_module_function(mDCL, "udrqvl", dcl_udrqvl, 1);
    rb_define_module_function(mDCL, "udrsvl", dcl_udrsvl, 2);
    rb_define_module_function(mDCL, "udrqin", dcl_udrqin, 1);
}