/*
 * $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_ulxlog(obj, cside, nlbl, nticks)
    VALUE obj, cside, nlbl, nticks;
{
    char *i_cside;
    integer i_nlbl;
    integer i_nticks;

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

    i_cside = STR2CSTR(cside);
    i_nlbl = NUM2INT(nlbl);
    i_nticks = NUM2INT(nticks);


    ulxlog_(i_cside, &i_nlbl, &i_nticks, (ftnlen)strlen(i_cside));

    return Qnil;

}

static VALUE
dcl_ulylog(obj, cside, nlbl, nticks)
    VALUE obj, cside, nlbl, nticks;
{
    char *i_cside;
    integer i_nlbl;
    integer i_nticks;

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

    i_cside = STR2CSTR(cside);
    i_nlbl = NUM2INT(nlbl);
    i_nticks = NUM2INT(nticks);


    ulylog_(i_cside, &i_nlbl, &i_nticks, (ftnlen)strlen(i_cside));

    return Qnil;

}

static VALUE
dcl_ulxlbl(obj, inum)
    VALUE obj, inum;
{
    real *o_bl;
    integer o_nbl;
    integer i_inum;
    VALUE bl;
    VALUE nbl;

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

    i_inum = NUM2INT(inum);

    o_bl= ALLOCA_N(real, (o_nbl));

    ulxlbl_(o_bl, &o_nbl, &i_inum);

    {int array_shape[1] = {o_nbl};
     bl = dcl_crealary2obj(o_bl, (o_nbl), 1, array_shape);
    }
    nbl = INT2NUM(o_nbl);


    return rb_ary_new3(2, bl, nbl);

}

static VALUE
dcl_ulsxbl(obj, bl, nbl)
    VALUE obj, bl, nbl;
{
    real *i_bl;
    integer i_nbl;

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

    i_nbl = NUM2INT(nbl);
    i_bl = dcl_obj2crealary(bl);


    ulsxbl_(i_bl, &i_nbl);

    dcl_freecrealary(i_bl);

    return Qnil;

}

static VALUE
dcl_ulqxbl(obj)
    VALUE obj;
{
    real *o_bl;
    integer o_nbl;
    VALUE bl;
    VALUE nbl;

    o_bl= ALLOCA_N(real, (o_nbl));

    ulqxbl_(o_bl, &o_nbl);

    {int array_shape[1] = {o_nbl};
     bl = dcl_crealary2obj(o_bl, (o_nbl), 1, array_shape);
    }
    nbl = INT2NUM(o_nbl);


    return rb_ary_new3(2, bl, nbl);

}

static VALUE
dcl_ulylbl(obj, inum)
    VALUE obj, inum;
{
    real *o_bl;
    integer o_nbl;
    integer i_inum;
    VALUE bl;
    VALUE nbl;

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

    i_inum = NUM2INT(inum);

    o_bl= ALLOCA_N(real, (o_nbl));

    ulylbl_(o_bl, &o_nbl, &i_inum);

    {int array_shape[1] = {o_nbl};
     bl = dcl_crealary2obj(o_bl, (o_nbl), 1, array_shape);
    }
    nbl = INT2NUM(o_nbl);


    return rb_ary_new3(2, bl, nbl);

}

static VALUE
dcl_ulsybl(obj, bl, nbl)
    VALUE obj, bl, nbl;
{
    real *i_bl;
    integer i_nbl;

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

    i_nbl = NUM2INT(nbl);
    i_bl = dcl_obj2crealary(bl);


    ulsybl_(i_bl, &i_nbl);

    dcl_freecrealary(i_bl);

    return Qnil;

}

static VALUE
dcl_ulqybl(obj)
    VALUE obj;
{
    real *o_bl;
    integer o_nbl;
    VALUE bl;
    VALUE nbl;

    o_bl= ALLOCA_N(real, (o_nbl));

    ulqybl_(o_bl, &o_nbl);

    {int array_shape[1] = {o_nbl};
     bl = dcl_crealary2obj(o_bl, (o_nbl), 1, array_shape);
    }
    nbl = INT2NUM(o_nbl);


    return rb_ary_new3(2, bl, nbl);

}

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

    ulpqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_ulpqid(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);


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

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_ulpqcp(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_ulpqcl(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_ulpqit(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);


    ulpqit_(&i_idx, &o_itp);

    itp = INT2NUM(o_itp);


    return itp;

}

static VALUE
dcl_ulpqvl(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);


    ulpqvl_(&i_idx, &o_ipara);

    ipara = INT2NUM(o_ipara);


    return ipara;

}

static VALUE
dcl_ulpsvl(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);


    ulpsvl_(&i_idx, &i_ipara);

    return Qnil;

}

static VALUE
dcl_ulpqin(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);


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

    in = INT2NUM(o_in);


    return in;

}

static VALUE
dcl_uliget(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);


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

    ipara = INT2NUM(o_ipara);


    return ipara;

}

static VALUE
dcl_uliset(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);


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

    return Qnil;

}

static VALUE
dcl_ulistx(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);


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

    return Qnil;

}

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

    uliqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_uliqid(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);


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

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_uliqcp(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_uliqcl(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_uliqvl(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);


    uliqvl_(&i_idx, &o_ipara);

    ipara = INT2NUM(o_ipara);


    return ipara;

}

static VALUE
dcl_ulisvl(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);


    ulisvl_(&i_idx, &i_ipara);

    return Qnil;

}

static VALUE
dcl_uliqin(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);


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

    in = INT2NUM(o_in);


    return in;

}

static VALUE
dcl_ullget(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);


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

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


    return lpara;

}

static VALUE
dcl_ullset(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_;


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

    return Qnil;

}

static VALUE
dcl_ullstx(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_;


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

    return Qnil;

}

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

    ullqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_ullqid(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);


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

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_ullqcp(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_ullqcl(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_ullqvl(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);


    ullqvl_(&i_idx, &o_lpara);

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


    return lpara;

}

static VALUE
dcl_ullsvl(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_;


    ullsvl_(&i_idx, &i_lpara);

    return Qnil;

}

static VALUE
dcl_ullqin(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);


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

    in = INT2NUM(o_in);


    return in;

}

static VALUE
dcl_ulrget(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);


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

    rpara = rb_float_new((double)o_rpara);


    return rpara;

}

static VALUE
dcl_ulrset(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);


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

    return Qnil;

}

static VALUE
dcl_ulrstx(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);


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

    return Qnil;

}

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

    ulrqnp_(&o_ncp);

    ncp = INT2NUM(o_ncp);


    return ncp;

}

static VALUE
dcl_ulrqid(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);


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

    idx = INT2NUM(o_idx);


    return idx;

}

static VALUE
dcl_ulrqcp(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_ulrqcl(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);

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

    cp = rb_str_new2(o_cp);


    return cp;

}

static VALUE
dcl_ulrqvl(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);


    ulrqvl_(&i_idx, &o_rpara);

    rpara = rb_float_new((double)o_rpara);


    return rpara;

}

static VALUE
dcl_ulrsvl(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);


    ulrsvl_(&i_idx, &i_rpara);

    return Qnil;

}

static VALUE
dcl_ulrqin(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);


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

    in = INT2NUM(o_in);


    return in;

}

static VALUE
dcl_ulxsfm(obj, cxfmt)
    VALUE obj, cxfmt;
{
    char *i_cxfmt;

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

    i_cxfmt = STR2CSTR(cxfmt);


    ulxsfm_(i_cxfmt, (ftnlen)strlen(i_cxfmt));

    return Qnil;

}

static VALUE
dcl_ulxqfm(obj)
    VALUE obj;
{
    char *o_cxfmt;
    VALUE cxfmt;

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

    ulxqfm_(o_cxfmt, (ftnlen)DFLT_SIZE);

    cxfmt = rb_str_new2(o_cxfmt);


    return cxfmt;

}

static VALUE
dcl_ulysfm(obj, cyfmt)
    VALUE obj, cyfmt;
{
    char *i_cyfmt;

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

    i_cyfmt = STR2CSTR(cyfmt);


    ulysfm_(i_cyfmt, (ftnlen)strlen(i_cyfmt));

    return Qnil;

}

static VALUE
dcl_ulyqfm(obj)
    VALUE obj;
{
    char *o_cyfmt;
    VALUE cyfmt;

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

    ulyqfm_(o_cyfmt, (ftnlen)DFLT_SIZE);

    cyfmt = rb_str_new2(o_cyfmt);


    return cyfmt;

}
void
init_grph2_ulpack(mDCL)
VALUE mDCL;
{
    rb_define_module_function(mDCL, "ulxlog", dcl_ulxlog, 3);
    rb_define_module_function(mDCL, "ulylog", dcl_ulylog, 3);
    rb_define_module_function(mDCL, "ulxlbl", dcl_ulxlbl, 1);
    rb_define_module_function(mDCL, "ulsxbl", dcl_ulsxbl, 2);
    rb_define_module_function(mDCL, "ulqxbl", dcl_ulqxbl, 0);
    rb_define_module_function(mDCL, "ulylbl", dcl_ulylbl, 1);
    rb_define_module_function(mDCL, "ulsybl", dcl_ulsybl, 2);
    rb_define_module_function(mDCL, "ulqybl", dcl_ulqybl, 0);
    rb_define_module_function(mDCL, "ulpqnp", dcl_ulpqnp, 0);
    rb_define_module_function(mDCL, "ulpqid", dcl_ulpqid, 1);
    rb_define_module_function(mDCL, "ulpqcp", dcl_ulpqcp, 1);
    rb_define_module_function(mDCL, "ulpqcl", dcl_ulpqcl, 1);
    rb_define_module_function(mDCL, "ulpqit", dcl_ulpqit, 1);
    rb_define_module_function(mDCL, "ulpqvl", dcl_ulpqvl, 1);
    rb_define_module_function(mDCL, "ulpsvl", dcl_ulpsvl, 2);
    rb_define_module_function(mDCL, "ulpqin", dcl_ulpqin, 1);
    rb_define_module_function(mDCL, "uliget", dcl_uliget, 1);
    rb_define_module_function(mDCL, "uliset", dcl_uliset, 2);
    rb_define_module_function(mDCL, "ulistx", dcl_ulistx, 2);
    rb_define_module_function(mDCL, "uliqnp", dcl_uliqnp, 0);
    rb_define_module_function(mDCL, "uliqid", dcl_uliqid, 1);
    rb_define_module_function(mDCL, "uliqcp", dcl_uliqcp, 1);
    rb_define_module_function(mDCL, "uliqcl", dcl_uliqcl, 1);
    rb_define_module_function(mDCL, "uliqvl", dcl_uliqvl, 1);
    rb_define_module_function(mDCL, "ulisvl", dcl_ulisvl, 2);
    rb_define_module_function(mDCL, "uliqin", dcl_uliqin, 1);
    rb_define_module_function(mDCL, "ullget", dcl_ullget, 1);
    rb_define_module_function(mDCL, "ullset", dcl_ullset, 2);
    rb_define_module_function(mDCL, "ullstx", dcl_ullstx, 2);
    rb_define_module_function(mDCL, "ullqnp", dcl_ullqnp, 0);
    rb_define_module_function(mDCL, "ullqid", dcl_ullqid, 1);
    rb_define_module_function(mDCL, "ullqcp", dcl_ullqcp, 1);
    rb_define_module_function(mDCL, "ullqcl", dcl_ullqcl, 1);
    rb_define_module_function(mDCL, "ullqvl", dcl_ullqvl, 1);
    rb_define_module_function(mDCL, "ullsvl", dcl_ullsvl, 2);
    rb_define_module_function(mDCL, "ullqin", dcl_ullqin, 1);
    rb_define_module_function(mDCL, "ulrget", dcl_ulrget, 1);
    rb_define_module_function(mDCL, "ulrset", dcl_ulrset, 2);
    rb_define_module_function(mDCL, "ulrstx", dcl_ulrstx, 2);
    rb_define_module_function(mDCL, "ulrqnp", dcl_ulrqnp, 0);
    rb_define_module_function(mDCL, "ulrqid", dcl_ulrqid, 1);
    rb_define_module_function(mDCL, "ulrqcp", dcl_ulrqcp, 1);
    rb_define_module_function(mDCL, "ulrqcl", dcl_ulrqcl, 1);
    rb_define_module_function(mDCL, "ulrqvl", dcl_ulrqvl, 1);
    rb_define_module_function(mDCL, "ulrsvl", dcl_ulrsvl, 2);
    rb_define_module_function(mDCL, "ulrqin", dcl_ulrqin, 1);
    rb_define_module_function(mDCL, "ulxsfm", dcl_ulxsfm, 1);
    rb_define_module_function(mDCL, "ulxqfm", dcl_ulxqfm, 0);
    rb_define_module_function(mDCL, "ulysfm", dcl_ulysfm, 1);
    rb_define_module_function(mDCL, "ulyqfm", dcl_ulyqfm, 0);
}


syntax highlighted by Code2HTML, v. 0.9.1