/* * $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_usgrph(obj, n, x, y) VALUE obj, n, x, y; { integer i_n; real *i_x; real *i_y; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(x) == T_FLOAT) { x = rb_Array(x); } /* if ((TYPE(x) != T_ARRAY) && (rb_obj_is_kind_of(x, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(y) == T_FLOAT) { y = rb_Array(y); } /* if ((TYPE(y) != T_ARRAY) && (rb_obj_is_kind_of(y, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_n = NUM2INT(n); i_x = dcl_obj2crealary(x); i_y = dcl_obj2crealary(y); usgrph_(&i_n, i_x, i_y); dcl_freecrealary(i_x); dcl_freecrealary(i_y); return Qnil; } static VALUE dcl_ussttl(obj, cxttl, cxunit, cyttl, cyunit) VALUE obj, cxttl, cxunit, cyttl, cyunit; { char *i_cxttl; char *i_cxunit; char *i_cyttl; char *i_cyunit; if (TYPE(cxttl) != T_STRING) { cxttl = rb_funcall(cxttl, rb_intern("to_str"), 0); } if (TYPE(cxunit) != T_STRING) { cxunit = rb_funcall(cxunit, rb_intern("to_str"), 0); } if (TYPE(cyttl) != T_STRING) { cyttl = rb_funcall(cyttl, rb_intern("to_str"), 0); } if (TYPE(cyunit) != T_STRING) { cyunit = rb_funcall(cyunit, rb_intern("to_str"), 0); } i_cxttl = STR2CSTR(cxttl); i_cxunit = STR2CSTR(cxunit); i_cyttl = STR2CSTR(cyttl); i_cyunit = STR2CSTR(cyunit); ussttl_(i_cxttl, i_cxunit, i_cyttl, i_cyunit, (ftnlen)strlen(i_cxttl), (ftnlen)strlen(i_cxunit), (ftnlen)strlen(i_cyttl), (ftnlen)strlen(i_cyunit)); return Qnil; } static VALUE dcl_usspnt(obj, n, x, y) VALUE obj, n, x, y; { integer i_n; real *i_x; real *i_y; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(x) == T_FLOAT) { x = rb_Array(x); } /* if ((TYPE(x) != T_ARRAY) && (rb_obj_is_kind_of(x, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(y) == T_FLOAT) { y = rb_Array(y); } /* if ((TYPE(y) != T_ARRAY) && (rb_obj_is_kind_of(y, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_n = NUM2INT(n); i_x = dcl_obj2crealary(x); i_y = dcl_obj2crealary(y); usspnt_(&i_n, i_x, i_y); dcl_freecrealary(i_x); dcl_freecrealary(i_y); return Qnil; } static VALUE dcl_uspfit(obj) VALUE obj; { uspfit_(); return Qnil; } static VALUE dcl_usdaxs(obj) VALUE obj; { usdaxs_(); return Qnil; } static VALUE dcl_usinit(obj) VALUE obj; { usinit_(); return Qnil; } static VALUE dcl_uspqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uspqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uspqid(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); uspqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uspqcp(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); uspqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uspqcl(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); uspqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uspqit(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); uspqit_(&i_idx, &o_itp); itp = INT2NUM(o_itp); return itp; } static VALUE dcl_uspqvl(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); uspqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uspsvl(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); uspsvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_uspqin(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); uspqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uscget(obj, cp) VALUE obj, cp; { char *i_cp; char *o_cpara; VALUE cpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); o_cpara= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cpara, '\0', DFLT_SIZE+1); uscget_(i_cp, o_cpara, (ftnlen)strlen(i_cp), (ftnlen)DFLT_SIZE); cpara = rb_str_new2(o_cpara); return cpara; } static VALUE dcl_uscset(obj, cp, cpara) VALUE obj, cp, cpara; { char *i_cp; char *i_cpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if (TYPE(cpara) != T_STRING) { cpara = rb_funcall(cpara, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); i_cpara = STR2CSTR(cpara); uscset_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara)); return Qnil; } static VALUE dcl_uscstx(obj, cp, cpara) VALUE obj, cp, cpara; { char *i_cp; char *i_cpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if (TYPE(cpara) != T_STRING) { cpara = rb_funcall(cpara, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); i_cpara = STR2CSTR(cpara); uscstx_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara)); return Qnil; } static VALUE dcl_uscqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uscqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uscqid(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); uscqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uscqcp(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); uscqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uscqcl(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); uscqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uscqvl(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cval; VALUE cval; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cval= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cval, '\0', DFLT_SIZE+1); uscqvl_(&i_idx, o_cval, (ftnlen)DFLT_SIZE); cval = rb_str_new2(o_cval); return cval; } static VALUE dcl_uscsvl(obj, idx, cval) VALUE obj, idx, cval; { integer i_idx; char *i_cval; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } if (TYPE(cval) != T_STRING) { cval = rb_funcall(cval, rb_intern("to_str"), 0); } i_idx = NUM2INT(idx); i_cval = STR2CSTR(cval); uscsvl_(&i_idx, i_cval, (ftnlen)strlen(i_cval)); return Qnil; } static VALUE dcl_uscqin(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); uscqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_usurdl(obj, umin, umax, vmin, vmax) VALUE obj, umin, umax, vmin, vmax; { real io_umin; real io_umax; real i_vmin; real i_vmax; if (TYPE(umin) != T_FLOAT) { umin = rb_funcall(umin, rb_intern("to_f"), 0); } if (TYPE(umax) != T_FLOAT) { umax = rb_funcall(umax, rb_intern("to_f"), 0); } if (TYPE(vmin) != T_FLOAT) { vmin = rb_funcall(vmin, rb_intern("to_f"), 0); } if (TYPE(vmax) != T_FLOAT) { vmax = rb_funcall(vmax, rb_intern("to_f"), 0); } io_umin = (real)NUM2DBL(umin); io_umax = (real)NUM2DBL(umax); i_vmin = (real)NUM2DBL(vmin); i_vmax = (real)NUM2DBL(vmax); usurdl_(&io_umin, &io_umax, &i_vmin, &i_vmax); umin = rb_float_new((double)io_umin); umax = rb_float_new((double)io_umax); return rb_ary_new3(2, umin, umax); } static VALUE dcl_usxaxs(obj, cside) VALUE obj, cside; { char *i_cside; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } i_cside = STR2CSTR(cside); usxaxs_(i_cside, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_usyaxs(obj, cside) VALUE obj, cside; { char *i_cside; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } i_cside = STR2CSTR(cside); usyaxs_(i_cside, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_ususcu(obj, caxis, umin, umax, vmin, vmax, mode) VALUE obj, caxis, umin, umax, vmin, vmax, mode; { char *i_caxis; real i_umin; real i_umax; real i_vmin; real i_vmax; integer i_mode; if (TYPE(caxis) != T_STRING) { caxis = rb_funcall(caxis, rb_intern("to_str"), 0); } if (TYPE(umin) != T_FLOAT) { umin = rb_funcall(umin, rb_intern("to_f"), 0); } if (TYPE(umax) != T_FLOAT) { umax = rb_funcall(umax, rb_intern("to_f"), 0); } if (TYPE(vmin) != T_FLOAT) { vmin = rb_funcall(vmin, rb_intern("to_f"), 0); } if (TYPE(vmax) != T_FLOAT) { vmax = rb_funcall(vmax, rb_intern("to_f"), 0); } if ((TYPE(mode) != T_BIGNUM) || (TYPE(mode) != T_FIXNUM)) { mode = rb_funcall(mode, rb_intern("to_i"), 0); } i_caxis = STR2CSTR(caxis); i_umin = (real)NUM2DBL(umin); i_umax = (real)NUM2DBL(umax); i_vmin = (real)NUM2DBL(vmin); i_vmax = (real)NUM2DBL(vmax); i_mode = NUM2INT(mode); ususcu_(i_caxis, &i_umin, &i_umax, &i_vmin, &i_vmax, &i_mode, (ftnlen)strlen(i_caxis)); return Qnil; } static VALUE dcl_ususcl(obj, caxis, umin, umax, vmin, vmax) VALUE obj, caxis, umin, umax, vmin, vmax; { char *i_caxis; real i_umin; real i_umax; real i_vmin; real i_vmax; if (TYPE(caxis) != T_STRING) { caxis = rb_funcall(caxis, rb_intern("to_str"), 0); } if (TYPE(umin) != T_FLOAT) { umin = rb_funcall(umin, rb_intern("to_f"), 0); } if (TYPE(umax) != T_FLOAT) { umax = rb_funcall(umax, rb_intern("to_f"), 0); } if (TYPE(vmin) != T_FLOAT) { vmin = rb_funcall(vmin, rb_intern("to_f"), 0); } if (TYPE(vmax) != T_FLOAT) { vmax = rb_funcall(vmax, rb_intern("to_f"), 0); } i_caxis = STR2CSTR(caxis); i_umin = (real)NUM2DBL(umin); i_umax = (real)NUM2DBL(umax); i_vmin = (real)NUM2DBL(vmin); i_vmax = (real)NUM2DBL(vmax); ususcl_(i_caxis, &i_umin, &i_umax, &i_vmin, &i_vmax, (ftnlen)strlen(i_caxis)); return Qnil; } static VALUE dcl_usxaxu(obj, cxs) VALUE obj, cxs; { char *i_cxs; if (TYPE(cxs) != T_STRING) { cxs = rb_funcall(cxs, rb_intern("to_str"), 0); } i_cxs = STR2CSTR(cxs); usxaxu_(i_cxs, (ftnlen)strlen(i_cxs)); return Qnil; } static VALUE dcl_usxaxl(obj, cxs) VALUE obj, cxs; { char *i_cxs; if (TYPE(cxs) != T_STRING) { cxs = rb_funcall(cxs, rb_intern("to_str"), 0); } i_cxs = STR2CSTR(cxs); usxaxl_(i_cxs, (ftnlen)strlen(i_cxs)); return Qnil; } static VALUE dcl_usyaxu(obj, cys) VALUE obj, cys; { char *i_cys; if (TYPE(cys) != T_STRING) { cys = rb_funcall(cys, rb_intern("to_str"), 0); } i_cys = STR2CSTR(cys); usyaxu_(i_cys, (ftnlen)strlen(i_cys)); return Qnil; } static VALUE dcl_usyaxl(obj, cys) VALUE obj, cys; { char *i_cys; if (TYPE(cys) != T_STRING) { cys = rb_funcall(cys, rb_intern("to_str"), 0); } i_cys = STR2CSTR(cys); usyaxl_(i_cys, (ftnlen)strlen(i_cys)); return Qnil; } static VALUE dcl_usxsub(obj, cxa, cya, clabel, rlbl) VALUE obj, cxa, cya, clabel, rlbl; { char *i_cxa; char *i_cya; char *i_clabel; real i_rlbl; if (TYPE(cxa) != T_STRING) { cxa = rb_funcall(cxa, rb_intern("to_str"), 0); } if (TYPE(cya) != T_STRING) { cya = rb_funcall(cya, rb_intern("to_str"), 0); } if (TYPE(clabel) != T_STRING) { clabel = rb_funcall(clabel, rb_intern("to_str"), 0); } if (TYPE(rlbl) != T_FLOAT) { rlbl = rb_funcall(rlbl, rb_intern("to_f"), 0); } i_cxa = STR2CSTR(cxa); i_cya = STR2CSTR(cya); i_clabel = STR2CSTR(clabel); i_rlbl = (real)NUM2DBL(rlbl); usxsub_(i_cxa, i_cya, i_clabel, &i_rlbl, (ftnlen)strlen(i_cxa), (ftnlen)strlen(i_cya), (ftnlen)strlen(i_clabel)); return Qnil; } static VALUE dcl_usysub(obj, cya, cxa, clabel, rlbl) VALUE obj, cya, cxa, clabel, rlbl; { char *i_cya; char *i_cxa; char *i_clabel; real i_rlbl; if (TYPE(cya) != T_STRING) { cya = rb_funcall(cya, rb_intern("to_str"), 0); } if (TYPE(cxa) != T_STRING) { cxa = rb_funcall(cxa, rb_intern("to_str"), 0); } if (TYPE(clabel) != T_STRING) { clabel = rb_funcall(clabel, rb_intern("to_str"), 0); } if (TYPE(rlbl) != T_FLOAT) { rlbl = rb_funcall(rlbl, rb_intern("to_f"), 0); } i_cya = STR2CSTR(cya); i_cxa = STR2CSTR(cxa); i_clabel = STR2CSTR(clabel); i_rlbl = (real)NUM2DBL(rlbl); usysub_(i_cya, i_cxa, i_clabel, &i_rlbl, (ftnlen)strlen(i_cya), (ftnlen)strlen(i_cxa), (ftnlen)strlen(i_clabel)); return Qnil; } static VALUE dcl_csblbl(obj, ufac, uoff, cunit) VALUE obj, ufac, uoff, cunit; { real i_ufac; real i_uoff; char *i_cunit; char *o_rtn_val; VALUE rtn_val; if (TYPE(ufac) != T_FLOAT) { ufac = rb_funcall(ufac, rb_intern("to_f"), 0); } if (TYPE(uoff) != T_FLOAT) { uoff = rb_funcall(uoff, rb_intern("to_f"), 0); } if (TYPE(cunit) != T_STRING) { cunit = rb_funcall(cunit, rb_intern("to_str"), 0); } i_ufac = (real)NUM2DBL(ufac); i_uoff = (real)NUM2DBL(uoff); i_cunit = STR2CSTR(cunit); o_rtn_val= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_rtn_val, '\0', DFLT_SIZE+1); csblbl_(o_rtn_val, (ftnlen)DFLT_SIZE, &i_ufac, &i_uoff, i_cunit, (ftnlen)strlen(i_cunit)); rtn_val = rb_str_new2(o_rtn_val); return rtn_val; } static VALUE dcl_uschvl(obj, x) VALUE obj, x; { real i_x; char *o_chx; VALUE chx; if (TYPE(x) != T_FLOAT) { x = rb_funcall(x, rb_intern("to_f"), 0); } i_x = (real)NUM2DBL(x); o_chx= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_chx, '\0', DFLT_SIZE+1); uschvl_(&i_x, o_chx, (ftnlen)DFLT_SIZE); chx = rb_str_new2(o_chx); return chx; } static VALUE dcl_usxoff(obj, cxs) VALUE obj, cxs; { char *i_cxs; if (TYPE(cxs) != T_STRING) { cxs = rb_funcall(cxs, rb_intern("to_str"), 0); } i_cxs = STR2CSTR(cxs); usxoff_(i_cxs, (ftnlen)strlen(i_cxs)); return Qnil; } static VALUE dcl_usyoff(obj, cys) VALUE obj, cys; { char *i_cys; if (TYPE(cys) != T_STRING) { cys = rb_funcall(cys, rb_intern("to_str"), 0); } i_cys = STR2CSTR(cys); usyoff_(i_cys, (ftnlen)strlen(i_cys)); return Qnil; } static VALUE dcl_uszdgt(obj, umin, umax, dul, maxdgt, uoff, ufact) VALUE obj, umin, umax, dul, maxdgt, uoff, ufact; { real i_umin; real i_umax; real i_dul; integer i_maxdgt; real io_uoff; real io_ufact; integer o_ndgt; integer o_ldgt; VALUE ndgt; VALUE ldgt; if (TYPE(umin) != T_FLOAT) { umin = rb_funcall(umin, rb_intern("to_f"), 0); } if (TYPE(umax) != T_FLOAT) { umax = rb_funcall(umax, rb_intern("to_f"), 0); } if (TYPE(dul) != T_FLOAT) { dul = rb_funcall(dul, rb_intern("to_f"), 0); } if ((TYPE(maxdgt) != T_BIGNUM) || (TYPE(maxdgt) != T_FIXNUM)) { maxdgt = rb_funcall(maxdgt, rb_intern("to_i"), 0); } if (TYPE(uoff) != T_FLOAT) { uoff = rb_funcall(uoff, rb_intern("to_f"), 0); } if (TYPE(ufact) != T_FLOAT) { ufact = rb_funcall(ufact, rb_intern("to_f"), 0); } i_umin = (real)NUM2DBL(umin); i_umax = (real)NUM2DBL(umax); i_dul = (real)NUM2DBL(dul); i_maxdgt = NUM2INT(maxdgt); io_uoff = (real)NUM2DBL(uoff); io_ufact = (real)NUM2DBL(ufact); uszdgt_(&i_umin, &i_umax, &i_dul, &i_maxdgt, &io_uoff, &io_ufact, &o_ndgt, &o_ldgt); uoff = rb_float_new((double)io_uoff); ufact = rb_float_new((double)io_ufact); ndgt = INT2NUM(o_ndgt); ldgt = INT2NUM(o_ldgt); return rb_ary_new3(4, uoff, ufact, ndgt, ldgt); } static VALUE dcl_uswapz(obj, x1, x2, n) VALUE obj, x1, x2, n; { real *io_x1; real *io_x2; integer i_n; if (TYPE(x1) == T_FLOAT) { x1 = rb_Array(x1); } /* if ((TYPE(x1) != T_ARRAY) && (rb_obj_is_kind_of(x1, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(x2) == T_FLOAT) { x2 = rb_Array(x2); } /* if ((TYPE(x2) != T_ARRAY) && (rb_obj_is_kind_of(x2, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } i_n = NUM2INT(n); io_x1 = dcl_obj2crealary(x1); io_x2 = dcl_obj2crealary(x2); uswapz_(io_x1, io_x2, &i_n); {int array_shape[1] = {i_n}; x1 = dcl_crealary2obj(io_x1, (i_n), 1, array_shape); } {int array_shape[1] = {i_n}; x2 = dcl_crealary2obj(io_x2, (i_n), 1, array_shape); } dcl_freecrealary(io_x1); dcl_freecrealary(io_x2); return rb_ary_new3(2, x1, x2); } static VALUE dcl_usurdt(obj, umin, umax, vmin, vmax) VALUE obj, umin, umax, vmin, vmax; { real io_umin; real io_umax; real i_vmin; real i_vmax; real o_dut; VALUE dut; if (TYPE(umin) != T_FLOAT) { umin = rb_funcall(umin, rb_intern("to_f"), 0); } if (TYPE(umax) != T_FLOAT) { umax = rb_funcall(umax, rb_intern("to_f"), 0); } if (TYPE(vmin) != T_FLOAT) { vmin = rb_funcall(vmin, rb_intern("to_f"), 0); } if (TYPE(vmax) != T_FLOAT) { vmax = rb_funcall(vmax, rb_intern("to_f"), 0); } io_umin = (real)NUM2DBL(umin); io_umax = (real)NUM2DBL(umax); i_vmin = (real)NUM2DBL(vmin); i_vmax = (real)NUM2DBL(vmax); usurdt_(&io_umin, &io_umax, &i_vmin, &i_vmax, &o_dut); umin = rb_float_new((double)io_umin); umax = rb_float_new((double)io_umax); dut = rb_float_new((double)o_dut); return rb_ary_new3(3, umin, umax, dut); } static VALUE dcl_usaxcl(obj, cside, jd0, ctype, nd) VALUE obj, cside, jd0, ctype, nd; { char *i_cside; integer i_jd0; char *i_ctype; 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(ctype) != T_STRING) { ctype = rb_funcall(ctype, rb_intern("to_str"), 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_ctype = STR2CSTR(ctype); i_nd = NUM2INT(nd); usaxcl_(i_cside, &i_jd0, i_ctype, &i_nd, (ftnlen)strlen(i_cside), (ftnlen)strlen(i_ctype)); return Qnil; } static VALUE dcl_usaxdv(obj, cside, dtick, dlbl) VALUE obj, cside, dtick, dlbl; { char *i_cside; real i_dtick; real i_dlbl; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if (TYPE(dtick) != T_FLOAT) { dtick = rb_funcall(dtick, rb_intern("to_f"), 0); } if (TYPE(dlbl) != T_FLOAT) { dlbl = rb_funcall(dlbl, rb_intern("to_f"), 0); } i_cside = STR2CSTR(cside); i_dtick = (real)NUM2DBL(dtick); i_dlbl = (real)NUM2DBL(dlbl); usaxdv_(i_cside, &i_dtick, &i_dlbl, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_usaxlb(obj, cside, dtick, n1, dlabel, ch, nc, n2) VALUE obj, cside, dtick, n1, dlabel, ch, nc, n2; { char *i_cside; real *i_dtick; integer i_n1; real *i_dlabel; char *i_ch; integer i_nc; integer i_n2; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if (TYPE(dtick) == T_FLOAT) { dtick = rb_Array(dtick); } /* if ((TYPE(dtick) != T_ARRAY) && (rb_obj_is_kind_of(dtick, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n1) != T_BIGNUM) || (TYPE(n1) != T_FIXNUM)) { n1 = rb_funcall(n1, rb_intern("to_i"), 0); } if (TYPE(dlabel) == T_FLOAT) { dlabel = rb_Array(dlabel); } /* if ((TYPE(dlabel) != T_ARRAY) && (rb_obj_is_kind_of(dlabel, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(ch) == T_STRING) { ch = rb_Array(ch); } if (TYPE(ch) != T_ARRAY) { rb_raise(rb_eTypeError, "invalid type"); } if ((TYPE(nc) != T_BIGNUM) || (TYPE(nc) != T_FIXNUM)) { nc = rb_funcall(nc, rb_intern("to_i"), 0); } if ((TYPE(n2) != T_BIGNUM) || (TYPE(n2) != T_FIXNUM)) { n2 = rb_funcall(n2, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_n1 = NUM2INT(n1); i_nc = NUM2INT(nc); i_n2 = NUM2INT(n2); i_dtick = dcl_obj2crealary(dtick); i_dlabel = dcl_obj2crealary(dlabel); i_ch = dcl_obj2ccharary(ch, (i_n2*DFLT_SIZE), DFLT_SIZE); usaxlb_(i_cside, i_dtick, &i_n1, i_dlabel, i_ch, &i_nc, &i_n2, (ftnlen)strlen(i_cside), (ftnlen)DFLT_SIZE); dcl_freecrealary(i_dtick); dcl_freecrealary(i_dlabel); dcl_freeccharary(i_ch); return Qnil; } static VALUE dcl_usaxlg(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); usaxlg_(i_cside, &i_nlbl, &i_nticks, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_usaxnm(obj, cside, dtick, n1, dlabel, n2) VALUE obj, cside, dtick, n1, dlabel, n2; { char *i_cside; real *i_dtick; integer i_n1; real *i_dlabel; integer i_n2; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if (TYPE(dtick) == T_FLOAT) { dtick = rb_Array(dtick); } /* if ((TYPE(dtick) != T_ARRAY) && (rb_obj_is_kind_of(dtick, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n1) != T_BIGNUM) || (TYPE(n1) != T_FIXNUM)) { n1 = rb_funcall(n1, rb_intern("to_i"), 0); } if (TYPE(dlabel) == T_FLOAT) { dlabel = rb_Array(dlabel); } /* if ((TYPE(dlabel) != T_ARRAY) && (rb_obj_is_kind_of(dlabel, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n2) != T_BIGNUM) || (TYPE(n2) != T_FIXNUM)) { n2 = rb_funcall(n2, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_n1 = NUM2INT(n1); i_n2 = NUM2INT(n2); i_dtick = dcl_obj2crealary(dtick); i_dlabel = dcl_obj2crealary(dlabel); usaxnm_(i_cside, i_dtick, &i_n1, i_dlabel, &i_n2, (ftnlen)strlen(i_cside)); dcl_freecrealary(i_dtick); dcl_freecrealary(i_dlabel); return Qnil; } static VALUE dcl_usaxsc(obj, cside) VALUE obj, cside; { char *i_cside; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } i_cside = STR2CSTR(cside); usaxsc_(i_cside, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_usiget(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); usiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp)); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_usiset(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); usiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_usistx(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); usistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_usiqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; usiqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_usiqid(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); usiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_usiqcp(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); usiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_usiqcl(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); usiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_usiqvl(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); usiqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_usisvl(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); usisvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_usiqin(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); usiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uslget(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); uslget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp)); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uslset(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_; uslset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uslstx(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_; uslstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uslqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uslqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uslqid(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); uslqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uslqcp(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); uslqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uslqcl(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); uslqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uslqvl(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); uslqvl_(&i_idx, &o_lpara); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uslsvl(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_; uslsvl_(&i_idx, &i_lpara); return Qnil; } static VALUE dcl_uslqin(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); uslqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uspaxs(obj, cside, islct) VALUE obj, cside, islct; { char *i_cside; integer i_islct; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) { islct = rb_funcall(islct, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_islct = NUM2INT(islct); uspaxs_(i_cside, &i_islct, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_usplbl(obj, cside, islct, pos, ch, nc, n) VALUE obj, cside, islct, pos, ch, nc, n; { char *i_cside; integer i_islct; real *i_pos; char *i_ch; integer i_nc; integer i_n; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) { islct = rb_funcall(islct, rb_intern("to_i"), 0); } if (TYPE(pos) == T_FLOAT) { pos = rb_Array(pos); } /* if ((TYPE(pos) != T_ARRAY) && (rb_obj_is_kind_of(pos, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(ch) == T_STRING) { ch = rb_Array(ch); } if (TYPE(ch) != T_ARRAY) { rb_raise(rb_eTypeError, "invalid type"); } if ((TYPE(nc) != T_BIGNUM) || (TYPE(nc) != T_FIXNUM)) { nc = rb_funcall(nc, rb_intern("to_i"), 0); } if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_islct = NUM2INT(islct); i_nc = NUM2INT(nc); i_n = NUM2INT(n); i_pos = dcl_obj2crealary(pos); i_ch = dcl_obj2ccharary(ch, (i_n*DFLT_SIZE), DFLT_SIZE); usplbl_(i_cside, &i_islct, i_pos, i_ch, &i_nc, &i_n, (ftnlen)strlen(i_cside), (ftnlen)DFLT_SIZE); dcl_freecrealary(i_pos); dcl_freeccharary(i_ch); return Qnil; } static VALUE dcl_uspnum(obj, cside, islct, pos, n) VALUE obj, cside, islct, pos, n; { char *i_cside; integer i_islct; real *i_pos; integer i_n; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) { islct = rb_funcall(islct, rb_intern("to_i"), 0); } if (TYPE(pos) == T_FLOAT) { pos = rb_Array(pos); } /* if ((TYPE(pos) != T_ARRAY) && (rb_obj_is_kind_of(pos, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_islct = NUM2INT(islct); i_n = NUM2INT(n); i_pos = dcl_obj2crealary(pos); uspnum_(i_cside, &i_islct, i_pos, &i_n, (ftnlen)strlen(i_cside)); dcl_freecrealary(i_pos); return Qnil; } static VALUE dcl_usptmk(obj, cside, islct, pos, n) VALUE obj, cside, islct, pos, n; { char *i_cside; integer i_islct; real *i_pos; integer i_n; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) { islct = rb_funcall(islct, rb_intern("to_i"), 0); } if (TYPE(pos) == T_FLOAT) { pos = rb_Array(pos); } /* if ((TYPE(pos) != T_ARRAY) && (rb_obj_is_kind_of(pos, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } i_cside = STR2CSTR(cside); i_islct = NUM2INT(islct); i_n = NUM2INT(n); i_pos = dcl_obj2crealary(pos); usptmk_(i_cside, &i_islct, i_pos, &i_n, (ftnlen)strlen(i_cside)); dcl_freecrealary(i_pos); return Qnil; } static VALUE dcl_uspttl(obj, cside, islct, cttl, pos) VALUE obj, cside, islct, cttl, pos; { char *i_cside; integer i_islct; char *i_cttl; real i_pos; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) { islct = rb_funcall(islct, rb_intern("to_i"), 0); } if (TYPE(cttl) != T_STRING) { cttl = rb_funcall(cttl, rb_intern("to_str"), 0); } if (TYPE(pos) != T_FLOAT) { pos = rb_funcall(pos, rb_intern("to_f"), 0); } i_cside = STR2CSTR(cside); i_islct = NUM2INT(islct); i_cttl = STR2CSTR(cttl); i_pos = (real)NUM2DBL(pos); uspttl_(i_cside, &i_islct, i_cttl, &i_pos, (ftnlen)strlen(i_cside), (ftnlen)strlen(i_cttl)); return Qnil; } static VALUE dcl_usrget(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); usrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp)); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_usrset(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); usrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_usrstx(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); usrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_usrqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; usrqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_usrqid(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); usrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_usrqcp(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); usrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_usrqcl(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); usrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_usrqvl(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); usrqvl_(&i_idx, &o_rpara); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_usrsvl(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); usrsvl_(&i_idx, &i_rpara); return Qnil; } static VALUE dcl_usrqin(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); usrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_ussaxs(obj, cside) VALUE obj, cside; { char *i_cside; if (TYPE(cside) != T_STRING) { cside = rb_funcall(cside, rb_intern("to_str"), 0); } i_cside = STR2CSTR(cside); ussaxs_(i_cside, (ftnlen)strlen(i_cside)); return Qnil; } static VALUE dcl_usxinz(obj, csa) VALUE obj, csa; { char *i_csa; real o_faca; real o_offa; VALUE faca; VALUE offa; if (TYPE(csa) != T_STRING) { csa = rb_funcall(csa, rb_intern("to_str"), 0); } i_csa = STR2CSTR(csa); usxinz_(i_csa, &o_faca, &o_offa, (ftnlen)strlen(i_csa)); faca = rb_float_new((double)o_faca); offa = rb_float_new((double)o_offa); return rb_ary_new3(2, faca, offa); } static VALUE dcl_usxtlz(obj) VALUE obj; { usxtlz_(); return Qnil; } static VALUE dcl_usyinz(obj, csa) VALUE obj, csa; { char *i_csa; real o_faca; real o_offa; VALUE faca; VALUE offa; if (TYPE(csa) != T_STRING) { csa = rb_funcall(csa, rb_intern("to_str"), 0); } i_csa = STR2CSTR(csa); usyinz_(i_csa, &o_faca, &o_offa, (ftnlen)strlen(i_csa)); faca = rb_float_new((double)o_faca); offa = rb_float_new((double)o_offa); return rb_ary_new3(2, faca, offa); } static VALUE dcl_usytlz(obj) VALUE obj; { usytlz_(); return Qnil; } void init_grph2_uspack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "usgrph", dcl_usgrph, 3); rb_define_module_function(mDCL, "ussttl", dcl_ussttl, 4); rb_define_module_function(mDCL, "usspnt", dcl_usspnt, 3); rb_define_module_function(mDCL, "uspfit", dcl_uspfit, 0); rb_define_module_function(mDCL, "usdaxs", dcl_usdaxs, 0); rb_define_module_function(mDCL, "usinit", dcl_usinit, 0); rb_define_module_function(mDCL, "uspqnp", dcl_uspqnp, 0); rb_define_module_function(mDCL, "uspqid", dcl_uspqid, 1); rb_define_module_function(mDCL, "uspqcp", dcl_uspqcp, 1); rb_define_module_function(mDCL, "uspqcl", dcl_uspqcl, 1); rb_define_module_function(mDCL, "uspqit", dcl_uspqit, 1); rb_define_module_function(mDCL, "uspqvl", dcl_uspqvl, 1); rb_define_module_function(mDCL, "uspsvl", dcl_uspsvl, 2); rb_define_module_function(mDCL, "uspqin", dcl_uspqin, 1); rb_define_module_function(mDCL, "uscget", dcl_uscget, 1); rb_define_module_function(mDCL, "uscset", dcl_uscset, 2); rb_define_module_function(mDCL, "uscstx", dcl_uscstx, 2); rb_define_module_function(mDCL, "uscqnp", dcl_uscqnp, 0); rb_define_module_function(mDCL, "uscqid", dcl_uscqid, 1); rb_define_module_function(mDCL, "uscqcp", dcl_uscqcp, 1); rb_define_module_function(mDCL, "uscqcl", dcl_uscqcl, 1); rb_define_module_function(mDCL, "uscqvl", dcl_uscqvl, 1); rb_define_module_function(mDCL, "uscsvl", dcl_uscsvl, 2); rb_define_module_function(mDCL, "uscqin", dcl_uscqin, 1); rb_define_module_function(mDCL, "usurdl", dcl_usurdl, 4); rb_define_module_function(mDCL, "usxaxs", dcl_usxaxs, 1); rb_define_module_function(mDCL, "usyaxs", dcl_usyaxs, 1); rb_define_module_function(mDCL, "ususcu", dcl_ususcu, 6); rb_define_module_function(mDCL, "ususcl", dcl_ususcl, 5); rb_define_module_function(mDCL, "usxaxu", dcl_usxaxu, 1); rb_define_module_function(mDCL, "usxaxl", dcl_usxaxl, 1); rb_define_module_function(mDCL, "usyaxu", dcl_usyaxu, 1); rb_define_module_function(mDCL, "usyaxl", dcl_usyaxl, 1); rb_define_module_function(mDCL, "usxsub", dcl_usxsub, 4); rb_define_module_function(mDCL, "usysub", dcl_usysub, 4); rb_define_module_function(mDCL, "csblbl", dcl_csblbl, 3); rb_define_module_function(mDCL, "uschvl", dcl_uschvl, 1); rb_define_module_function(mDCL, "usxoff", dcl_usxoff, 1); rb_define_module_function(mDCL, "usyoff", dcl_usyoff, 1); rb_define_module_function(mDCL, "uszdgt", dcl_uszdgt, 6); rb_define_module_function(mDCL, "uswapz", dcl_uswapz, 3); rb_define_module_function(mDCL, "usurdt", dcl_usurdt, 4); rb_define_module_function(mDCL, "usaxcl", dcl_usaxcl, 4); rb_define_module_function(mDCL, "usaxdv", dcl_usaxdv, 3); rb_define_module_function(mDCL, "usaxlb", dcl_usaxlb, 7); rb_define_module_function(mDCL, "usaxlg", dcl_usaxlg, 3); rb_define_module_function(mDCL, "usaxnm", dcl_usaxnm, 5); rb_define_module_function(mDCL, "usaxsc", dcl_usaxsc, 1); rb_define_module_function(mDCL, "usiget", dcl_usiget, 1); rb_define_module_function(mDCL, "usiset", dcl_usiset, 2); rb_define_module_function(mDCL, "usistx", dcl_usistx, 2); rb_define_module_function(mDCL, "usiqnp", dcl_usiqnp, 0); rb_define_module_function(mDCL, "usiqid", dcl_usiqid, 1); rb_define_module_function(mDCL, "usiqcp", dcl_usiqcp, 1); rb_define_module_function(mDCL, "usiqcl", dcl_usiqcl, 1); rb_define_module_function(mDCL, "usiqvl", dcl_usiqvl, 1); rb_define_module_function(mDCL, "usisvl", dcl_usisvl, 2); rb_define_module_function(mDCL, "usiqin", dcl_usiqin, 1); rb_define_module_function(mDCL, "uslget", dcl_uslget, 1); rb_define_module_function(mDCL, "uslset", dcl_uslset, 2); rb_define_module_function(mDCL, "uslstx", dcl_uslstx, 2); rb_define_module_function(mDCL, "uslqnp", dcl_uslqnp, 0); rb_define_module_function(mDCL, "uslqid", dcl_uslqid, 1); rb_define_module_function(mDCL, "uslqcp", dcl_uslqcp, 1); rb_define_module_function(mDCL, "uslqcl", dcl_uslqcl, 1); rb_define_module_function(mDCL, "uslqvl", dcl_uslqvl, 1); rb_define_module_function(mDCL, "uslsvl", dcl_uslsvl, 2); rb_define_module_function(mDCL, "uslqin", dcl_uslqin, 1); rb_define_module_function(mDCL, "uspaxs", dcl_uspaxs, 2); rb_define_module_function(mDCL, "usplbl", dcl_usplbl, 6); rb_define_module_function(mDCL, "uspnum", dcl_uspnum, 4); rb_define_module_function(mDCL, "usptmk", dcl_usptmk, 4); rb_define_module_function(mDCL, "uspttl", dcl_uspttl, 4); rb_define_module_function(mDCL, "usrget", dcl_usrget, 1); rb_define_module_function(mDCL, "usrset", dcl_usrset, 2); rb_define_module_function(mDCL, "usrstx", dcl_usrstx, 2); rb_define_module_function(mDCL, "usrqnp", dcl_usrqnp, 0); rb_define_module_function(mDCL, "usrqid", dcl_usrqid, 1); rb_define_module_function(mDCL, "usrqcp", dcl_usrqcp, 1); rb_define_module_function(mDCL, "usrqcl", dcl_usrqcl, 1); rb_define_module_function(mDCL, "usrqvl", dcl_usrqvl, 1); rb_define_module_function(mDCL, "usrsvl", dcl_usrsvl, 2); rb_define_module_function(mDCL, "usrqin", dcl_usrqin, 1); rb_define_module_function(mDCL, "ussaxs", dcl_ussaxs, 1); rb_define_module_function(mDCL, "usxinz", dcl_usxinz, 1); rb_define_module_function(mDCL, "usxtlz", dcl_usxtlz, 0); rb_define_module_function(mDCL, "usyinz", dcl_usyinz, 1); rb_define_module_function(mDCL, "usytlz", dcl_usytlz, 0); }