/* * $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_uetone(obj, z, mx, nx, ny) VALUE obj, z, mx, nx, ny; { real *i_z; integer i_mx; integer i_nx; integer i_ny; if (TYPE(z) == T_FLOAT) { z = rb_Array(z); } /* if ((TYPE(z) != T_ARRAY) && (rb_obj_is_kind_of(z, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) { mx = rb_funcall(mx, rb_intern("to_i"), 0); } if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) { nx = rb_funcall(nx, rb_intern("to_i"), 0); } if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) { ny = rb_funcall(ny, rb_intern("to_i"), 0); } i_mx = NUM2INT(mx); i_nx = NUM2INT(nx); i_ny = NUM2INT(ny); i_z = dcl_obj2crealary(z); uetone_(i_z, &i_mx, &i_nx, &i_ny); dcl_freecrealary(i_z); return Qnil; } static VALUE dcl_uetonf(obj, z, mx, nx, ny) VALUE obj, z, mx, nx, ny; { real *i_z; integer i_mx; integer i_nx; integer i_ny; if (TYPE(z) == T_FLOAT) { z = rb_Array(z); } /* if ((TYPE(z) != T_ARRAY) && (rb_obj_is_kind_of(z, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) { mx = rb_funcall(mx, rb_intern("to_i"), 0); } if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) { nx = rb_funcall(nx, rb_intern("to_i"), 0); } if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) { ny = rb_funcall(ny, rb_intern("to_i"), 0); } i_mx = NUM2INT(mx); i_nx = NUM2INT(nx); i_ny = NUM2INT(ny); i_z = dcl_obj2crealary(z); uetonf_(i_z, &i_mx, &i_nx, &i_ny); dcl_freecrealary(i_z); return Qnil; } static VALUE dcl_uetonc(obj, z, mx, nx, ny) VALUE obj, z, mx, nx, ny; { real *i_z; integer i_mx; integer i_nx; integer i_ny; if (TYPE(z) == T_FLOAT) { z = rb_Array(z); } /* if ((TYPE(z) != T_ARRAY) && (rb_obj_is_kind_of(z, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) { mx = rb_funcall(mx, rb_intern("to_i"), 0); } if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) { nx = rb_funcall(nx, rb_intern("to_i"), 0); } if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) { ny = rb_funcall(ny, rb_intern("to_i"), 0); } i_mx = NUM2INT(mx); i_nx = NUM2INT(nx); i_ny = NUM2INT(ny); i_z = dcl_obj2crealary(z); uetonc_(i_z, &i_mx, &i_nx, &i_ny); dcl_freecrealary(i_z); return Qnil; } static VALUE dcl_uezchk(obj, z, mx, nx, ny, cname) VALUE obj, z, mx, nx, ny, cname; { real *i_z; integer i_mx; integer i_nx; integer i_ny; char *i_cname; integer o_istat; VALUE istat; if (TYPE(z) == T_FLOAT) { z = rb_Array(z); } /* if ((TYPE(z) != T_ARRAY) && (rb_obj_is_kind_of(z, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) { mx = rb_funcall(mx, rb_intern("to_i"), 0); } if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) { nx = rb_funcall(nx, rb_intern("to_i"), 0); } if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) { ny = rb_funcall(ny, rb_intern("to_i"), 0); } if (TYPE(cname) != T_STRING) { cname = rb_funcall(cname, rb_intern("to_str"), 0); } i_mx = NUM2INT(mx); i_nx = NUM2INT(nx); i_ny = NUM2INT(ny); i_cname = STR2CSTR(cname); i_z = dcl_obj2crealary(z); uezchk_(i_z, &i_mx, &i_nx, &i_ny, i_cname, &o_istat, (ftnlen)strlen(i_cname)); istat = INT2NUM(o_istat); dcl_freecrealary(i_z); return istat; } static VALUE dcl_uegtla(obj, xmin, xmax, dx) VALUE obj, xmin, xmax, dx; { real i_xmin; real i_xmax; real i_dx; if (TYPE(xmin) != T_FLOAT) { xmin = rb_funcall(xmin, rb_intern("to_f"), 0); } if (TYPE(xmax) != T_FLOAT) { xmax = rb_funcall(xmax, rb_intern("to_f"), 0); } if (TYPE(dx) != T_FLOAT) { dx = rb_funcall(dx, rb_intern("to_f"), 0); } i_xmin = (real)NUM2DBL(xmin); i_xmax = (real)NUM2DBL(xmax); i_dx = (real)NUM2DBL(dx); uegtla_(&i_xmin, &i_xmax, &i_dx); return Qnil; } static VALUE dcl_uegtlb(obj, z, mx, nx, ny, dx) VALUE obj, z, mx, nx, ny, dx; { real *i_z; integer i_mx; integer i_nx; integer i_ny; real i_dx; if (TYPE(z) == T_FLOAT) { z = rb_Array(z); } /* if ((TYPE(z) != T_ARRAY) && (rb_obj_is_kind_of(z, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(mx) != T_BIGNUM) || (TYPE(mx) != T_FIXNUM)) { mx = rb_funcall(mx, rb_intern("to_i"), 0); } if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) { nx = rb_funcall(nx, rb_intern("to_i"), 0); } if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) { ny = rb_funcall(ny, rb_intern("to_i"), 0); } if (TYPE(dx) != T_FLOAT) { dx = rb_funcall(dx, rb_intern("to_f"), 0); } i_mx = NUM2INT(mx); i_nx = NUM2INT(nx); i_ny = NUM2INT(ny); i_dx = (real)NUM2DBL(dx); i_z = dcl_obj2crealary(z); uegtlb_(i_z, &i_mx, &i_nx, &i_ny, &i_dx); dcl_freecrealary(i_z); return Qnil; } static VALUE dcl_ueitlv(obj) VALUE obj; { ueitlv_(); return Qnil; } static VALUE dcl_uestlv(obj, tlev1, tlev2, ipat) VALUE obj, tlev1, tlev2, ipat; { real i_tlev1; real i_tlev2; integer i_ipat; if (TYPE(tlev1) != T_FLOAT) { tlev1 = rb_funcall(tlev1, rb_intern("to_f"), 0); } if (TYPE(tlev2) != T_FLOAT) { tlev2 = rb_funcall(tlev2, rb_intern("to_f"), 0); } if ((TYPE(ipat) != T_BIGNUM) || (TYPE(ipat) != T_FIXNUM)) { ipat = rb_funcall(ipat, rb_intern("to_i"), 0); } i_tlev1 = (real)NUM2DBL(tlev1); i_tlev2 = (real)NUM2DBL(tlev2); i_ipat = NUM2INT(ipat); uestlv_(&i_tlev1, &i_tlev2, &i_ipat); return Qnil; } static VALUE dcl_ueqtlv(obj, iton) VALUE obj, iton; { real o_tlev1; real o_tlev2; integer o_ipat; integer i_iton; VALUE tlev1; VALUE tlev2; VALUE ipat; if ((TYPE(iton) != T_BIGNUM) || (TYPE(iton) != T_FIXNUM)) { iton = rb_funcall(iton, rb_intern("to_i"), 0); } i_iton = NUM2INT(iton); ueqtlv_(&o_tlev1, &o_tlev2, &o_ipat, &i_iton); tlev1 = rb_float_new((double)o_tlev1); tlev2 = rb_float_new((double)o_tlev2); ipat = INT2NUM(o_ipat); return rb_ary_new3(3, tlev1, tlev2, ipat); } static VALUE dcl_ueqntl(obj) VALUE obj; { integer o_nton; VALUE nton; ueqntl_(&o_nton); nton = INT2NUM(o_nton); return nton; } static VALUE dcl_uestln(obj, tlevn, ipatn, nton) VALUE obj, tlevn, ipatn, nton; { real *i_tlevn; integer *i_ipatn; integer i_nton; if (TYPE(tlevn) == T_FLOAT) { tlevn = rb_Array(tlevn); } /* if ((TYPE(tlevn) != T_ARRAY) && (rb_obj_is_kind_of(tlevn, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(ipatn) == T_BIGNUM) || (TYPE(ipatn) == T_FIXNUM)) { ipatn = rb_Array(ipatn); } /* if ((TYPE(ipatn) != T_ARRAY) && (rb_obj_is_kind_of(ipatn, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(nton) != T_BIGNUM) || (TYPE(nton) != T_FIXNUM)) { nton = rb_funcall(nton, rb_intern("to_i"), 0); } i_nton = NUM2INT(nton); i_tlevn = dcl_obj2crealary(tlevn); i_ipatn = dcl_obj2cintegerary(ipatn); uestln_(i_tlevn, i_ipatn, &i_nton); dcl_freecrealary(i_tlevn); dcl_freecintegerary(i_ipatn); return Qnil; } static VALUE dcl_iueton(obj, zlev) VALUE obj, zlev; { real i_zlev; integer o_rtn_val; VALUE rtn_val; if (TYPE(zlev) != T_FLOAT) { zlev = rb_funcall(zlev, rb_intern("to_f"), 0); } i_zlev = (real)NUM2DBL(zlev); o_rtn_val = iueton_(&i_zlev); rtn_val = INT2NUM(o_rtn_val); return rtn_val; } static VALUE dcl_uepqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uepqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uepqid(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); uepqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uepqcp(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); uepqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uepqcl(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); uepqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uepqit(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); uepqit_(&i_idx, &o_itp); itp = INT2NUM(o_itp); return itp; } static VALUE dcl_uepqvl(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); uepqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uepsvl(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); uepsvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_uepqin(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); uepqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_ueiget(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); ueiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp)); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_ueiset(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); ueiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_ueistx(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); ueistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_ueiqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; ueiqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_ueiqid(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); ueiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_ueiqcp(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); ueiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_ueiqcl(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); ueiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_ueiqvl(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); ueiqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_ueisvl(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); ueisvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_ueiqin(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); ueiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uelget(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); uelget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp)); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uelset(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_; uelset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uelstx(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_; uelstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uelqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uelqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uelqid(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); uelqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uelqcp(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); uelqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uelqcl(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); uelqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uelqvl(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); uelqvl_(&i_idx, &o_lpara); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uelsvl(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_; uelsvl_(&i_idx, &i_lpara); return Qnil; } static VALUE dcl_uelqin(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); uelqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uerget(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); uerget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp)); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_uerset(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); uerset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uerstx(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); uerstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uerqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uerqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uerqid(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); uerqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uerqcp(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); uerqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uerqcl(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); uerqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uerqvl(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); uerqvl_(&i_idx, &o_rpara); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_uersvl(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); uersvl_(&i_idx, &i_rpara); return Qnil; } static VALUE dcl_uerqin(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); uerqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } void init_grph2_uepack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "uetone", dcl_uetone, 4); rb_define_module_function(mDCL, "uetonf", dcl_uetonf, 4); rb_define_module_function(mDCL, "uetonc", dcl_uetonc, 4); rb_define_module_function(mDCL, "uezchk", dcl_uezchk, 5); rb_define_module_function(mDCL, "uegtla", dcl_uegtla, 3); rb_define_module_function(mDCL, "uegtlb", dcl_uegtlb, 5); rb_define_module_function(mDCL, "ueitlv", dcl_ueitlv, 0); rb_define_module_function(mDCL, "uestlv", dcl_uestlv, 3); rb_define_module_function(mDCL, "ueqtlv", dcl_ueqtlv, 1); rb_define_module_function(mDCL, "ueqntl", dcl_ueqntl, 0); rb_define_module_function(mDCL, "uestln", dcl_uestln, 3); rb_define_module_function(mDCL, "iueton", dcl_iueton, 1); rb_define_module_function(mDCL, "uepqnp", dcl_uepqnp, 0); rb_define_module_function(mDCL, "uepqid", dcl_uepqid, 1); rb_define_module_function(mDCL, "uepqcp", dcl_uepqcp, 1); rb_define_module_function(mDCL, "uepqcl", dcl_uepqcl, 1); rb_define_module_function(mDCL, "uepqit", dcl_uepqit, 1); rb_define_module_function(mDCL, "uepqvl", dcl_uepqvl, 1); rb_define_module_function(mDCL, "uepsvl", dcl_uepsvl, 2); rb_define_module_function(mDCL, "uepqin", dcl_uepqin, 1); rb_define_module_function(mDCL, "ueiget", dcl_ueiget, 1); rb_define_module_function(mDCL, "ueiset", dcl_ueiset, 2); rb_define_module_function(mDCL, "ueistx", dcl_ueistx, 2); rb_define_module_function(mDCL, "ueiqnp", dcl_ueiqnp, 0); rb_define_module_function(mDCL, "ueiqid", dcl_ueiqid, 1); rb_define_module_function(mDCL, "ueiqcp", dcl_ueiqcp, 1); rb_define_module_function(mDCL, "ueiqcl", dcl_ueiqcl, 1); rb_define_module_function(mDCL, "ueiqvl", dcl_ueiqvl, 1); rb_define_module_function(mDCL, "ueisvl", dcl_ueisvl, 2); rb_define_module_function(mDCL, "ueiqin", dcl_ueiqin, 1); rb_define_module_function(mDCL, "uelget", dcl_uelget, 1); rb_define_module_function(mDCL, "uelset", dcl_uelset, 2); rb_define_module_function(mDCL, "uelstx", dcl_uelstx, 2); rb_define_module_function(mDCL, "uelqnp", dcl_uelqnp, 0); rb_define_module_function(mDCL, "uelqid", dcl_uelqid, 1); rb_define_module_function(mDCL, "uelqcp", dcl_uelqcp, 1); rb_define_module_function(mDCL, "uelqcl", dcl_uelqcl, 1); rb_define_module_function(mDCL, "uelqvl", dcl_uelqvl, 1); rb_define_module_function(mDCL, "uelsvl", dcl_uelsvl, 2); rb_define_module_function(mDCL, "uelqin", dcl_uelqin, 1); rb_define_module_function(mDCL, "uerget", dcl_uerget, 1); rb_define_module_function(mDCL, "uerset", dcl_uerset, 2); rb_define_module_function(mDCL, "uerstx", dcl_uerstx, 2); rb_define_module_function(mDCL, "uerqnp", dcl_uerqnp, 0); rb_define_module_function(mDCL, "uerqid", dcl_uerqid, 1); rb_define_module_function(mDCL, "uerqcp", dcl_uerqcp, 1); rb_define_module_function(mDCL, "uerqcl", dcl_uerqcl, 1); rb_define_module_function(mDCL, "uerqvl", dcl_uerqvl, 1); rb_define_module_function(mDCL, "uersvl", dcl_uersvl, 2); rb_define_module_function(mDCL, "uerqin", dcl_uerqin, 1); }