/* * $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_ucpqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; ucpqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_ucpqid(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); ucpqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_ucpqcp(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); ucpqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_ucpqcl(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); ucpqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_ucpqit(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); ucpqit_(&i_idx, &o_itp); itp = INT2NUM(o_itp); return itp; } static VALUE dcl_ucpqvl(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); ucpqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_ucpsvl(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); ucpsvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_ucpqin(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); ucpqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_ucxacl(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucxacl_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ucxady(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucxady_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ucxamn(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucxamn_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ucxayr(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucxayr_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ucyacl(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucyacl_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ucyady(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucyady_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ucyamn(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucyamn_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ucyayr(obj, cside, jd0, nd) VALUE obj, cside, jd0, nd; { char *i_cside; integer i_jd0; integer i_nd; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) { jd0 = rb_funcall(jd0, rb_intern("to_i"), 0); } if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) { nd = rb_funcall(nd, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_jd0 = NUM2INT(jd0); i_nd = NUM2INT(nd); ucyayr_(i_cside, &i_jd0, &i_nd, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_uciget(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); uciget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp)); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uciset(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); uciset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_ucistx(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); ucistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uciqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uciqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uciqid(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); uciqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uciqcp(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); uciqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uciqcl(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); uciqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uciqvl(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); uciqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_ucisvl(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); ucisvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_uciqin(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); uciqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uclget(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); uclget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp)); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uclset(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_; uclset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uclstx(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_; uclstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uclqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uclqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uclqid(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); uclqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uclqcp(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); uclqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uclqcl(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); uclqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uclqvl(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); uclqvl_(&i_idx, &o_lpara); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uclsvl(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_; uclsvl_(&i_idx, &i_lpara); return Qnil; } static VALUE dcl_uclqin(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); uclqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_ucrget(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); ucrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp)); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_ucrset(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); ucrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_ucrstx(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); ucrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_ucrqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; ucrqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_ucrqid(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); ucrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_ucrqcp(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); ucrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_ucrqcl(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); ucrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_ucrqvl(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); ucrqvl_(&i_idx, &o_rpara); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_ucrsvl(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); ucrsvl_(&i_idx, &i_rpara); return Qnil; } static VALUE dcl_ucrqin(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); ucrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } void init_grph2_ucpack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "ucpqnp", dcl_ucpqnp, 0); rb_define_module_function(mDCL, "ucpqid", dcl_ucpqid, 1); rb_define_module_function(mDCL, "ucpqcp", dcl_ucpqcp, 1); rb_define_module_function(mDCL, "ucpqcl", dcl_ucpqcl, 1); rb_define_module_function(mDCL, "ucpqit", dcl_ucpqit, 1); rb_define_module_function(mDCL, "ucpqvl", dcl_ucpqvl, 1); rb_define_module_function(mDCL, "ucpsvl", dcl_ucpsvl, 2); rb_define_module_function(mDCL, "ucpqin", dcl_ucpqin, 1); rb_define_module_function(mDCL, "ucxacl", dcl_ucxacl, 3); rb_define_module_function(mDCL, "ucxady", dcl_ucxady, 3); rb_define_module_function(mDCL, "ucxamn", dcl_ucxamn, 3); rb_define_module_function(mDCL, "ucxayr", dcl_ucxayr, 3); rb_define_module_function(mDCL, "ucyacl", dcl_ucyacl, 3); rb_define_module_function(mDCL, "ucyady", dcl_ucyady, 3); rb_define_module_function(mDCL, "ucyamn", dcl_ucyamn, 3); rb_define_module_function(mDCL, "ucyayr", dcl_ucyayr, 3); rb_define_module_function(mDCL, "uciget", dcl_uciget, 1); rb_define_module_function(mDCL, "uciset", dcl_uciset, 2); rb_define_module_function(mDCL, "ucistx", dcl_ucistx, 2); rb_define_module_function(mDCL, "uciqnp", dcl_uciqnp, 0); rb_define_module_function(mDCL, "uciqid", dcl_uciqid, 1); rb_define_module_function(mDCL, "uciqcp", dcl_uciqcp, 1); rb_define_module_function(mDCL, "uciqcl", dcl_uciqcl, 1); rb_define_module_function(mDCL, "uciqvl", dcl_uciqvl, 1); rb_define_module_function(mDCL, "ucisvl", dcl_ucisvl, 2); rb_define_module_function(mDCL, "uciqin", dcl_uciqin, 1); rb_define_module_function(mDCL, "uclget", dcl_uclget, 1); rb_define_module_function(mDCL, "uclset", dcl_uclset, 2); rb_define_module_function(mDCL, "uclstx", dcl_uclstx, 2); rb_define_module_function(mDCL, "uclqnp", dcl_uclqnp, 0); rb_define_module_function(mDCL, "uclqid", dcl_uclqid, 1); rb_define_module_function(mDCL, "uclqcp", dcl_uclqcp, 1); rb_define_module_function(mDCL, "uclqcl", dcl_uclqcl, 1); rb_define_module_function(mDCL, "uclqvl", dcl_uclqvl, 1); rb_define_module_function(mDCL, "uclsvl", dcl_uclsvl, 2); rb_define_module_function(mDCL, "uclqin", dcl_uclqin, 1); rb_define_module_function(mDCL, "ucrget", dcl_ucrget, 1); rb_define_module_function(mDCL, "ucrset", dcl_ucrset, 2); rb_define_module_function(mDCL, "ucrstx", dcl_ucrstx, 2); rb_define_module_function(mDCL, "ucrqnp", dcl_ucrqnp, 0); rb_define_module_function(mDCL, "ucrqid", dcl_ucrqid, 1); rb_define_module_function(mDCL, "ucrqcp", dcl_ucrqcp, 1); rb_define_module_function(mDCL, "ucrqcl", dcl_ucrqcl, 1); rb_define_module_function(mDCL, "ucrqvl", dcl_ucrqvl, 1); rb_define_module_function(mDCL, "ucrsvl", dcl_ucrsvl, 2); rb_define_module_function(mDCL, "ucrqin", dcl_ucrqin, 1); }