/* * $Id: p_header,v 1.4 2000/11/27 01:57:01 keiko Exp $ */ #include #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); }