/* * $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_uulin(obj, n, upx, upy) VALUE obj, n, upx, upy; { integer i_n; real *i_upx; real *i_upy; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(upx) == T_FLOAT) { upx = rb_Array(upx); } /* if ((TYPE(upx) != T_ARRAY) && (rb_obj_is_kind_of(upx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(upy) == T_FLOAT) { upy = rb_Array(upy); } /* if ((TYPE(upy) != T_ARRAY) && (rb_obj_is_kind_of(upy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_n = NUM2INT(n); i_upx = dcl_obj2crealary(upx); i_upy = dcl_obj2crealary(upy); uulin_(&i_n, i_upx, i_upy); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); return Qnil; } static VALUE dcl_uulinz(obj, n, upx, upy, itype, index) VALUE obj, n, upx, upy, itype, index; { integer i_n; real *i_upx; real *i_upy; integer i_itype; integer i_index; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(upx) == T_FLOAT) { upx = rb_Array(upx); } /* if ((TYPE(upx) != T_ARRAY) && (rb_obj_is_kind_of(upx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(upy) == T_FLOAT) { upy = rb_Array(upy); } /* if ((TYPE(upy) != T_ARRAY) && (rb_obj_is_kind_of(upy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(itype) != T_BIGNUM) || (TYPE(itype) != T_FIXNUM)) { itype = rb_funcall(itype, rb_intern("to_i"), 0); } if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_itype = NUM2INT(itype); i_index = NUM2INT(index); i_upx = dcl_obj2crealary(upx); i_upy = dcl_obj2crealary(upy); uulinz_(&i_n, i_upx, i_upy, &i_itype, &i_index); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); return Qnil; } static VALUE dcl_uumrk(obj, n, upx, upy) VALUE obj, n, upx, upy; { integer i_n; real *i_upx; real *i_upy; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(upx) == T_FLOAT) { upx = rb_Array(upx); } /* if ((TYPE(upx) != T_ARRAY) && (rb_obj_is_kind_of(upx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(upy) == T_FLOAT) { upy = rb_Array(upy); } /* if ((TYPE(upy) != T_ARRAY) && (rb_obj_is_kind_of(upy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_n = NUM2INT(n); i_upx = dcl_obj2crealary(upx); i_upy = dcl_obj2crealary(upy); uumrk_(&i_n, i_upx, i_upy); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); return Qnil; } static VALUE dcl_uumrkz(obj, n, upx, upy, itype, index, rsize) VALUE obj, n, upx, upy, itype, index, rsize; { integer i_n; real *i_upx; real *i_upy; integer i_itype; integer i_index; real i_rsize; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(upx) == T_FLOAT) { upx = rb_Array(upx); } /* if ((TYPE(upx) != T_ARRAY) && (rb_obj_is_kind_of(upx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(upy) == T_FLOAT) { upy = rb_Array(upy); } /* if ((TYPE(upy) != T_ARRAY) && (rb_obj_is_kind_of(upy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(itype) != T_BIGNUM) || (TYPE(itype) != T_FIXNUM)) { itype = rb_funcall(itype, rb_intern("to_i"), 0); } if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } if (TYPE(rsize) != T_FLOAT) { rsize = rb_funcall(rsize, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_itype = NUM2INT(itype); i_index = NUM2INT(index); i_rsize = (real)NUM2DBL(rsize); i_upx = dcl_obj2crealary(upx); i_upy = dcl_obj2crealary(upy); uumrkz_(&i_n, i_upx, i_upy, &i_itype, &i_index, &i_rsize); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); return Qnil; } static VALUE dcl_uupqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uupqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uupqid(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); uupqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uupqcp(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); uupqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uupqcl(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); uupqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uupqit(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); uupqit_(&i_idx, &o_itp); itp = INT2NUM(o_itp); return itp; } static VALUE dcl_uupqvl(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); uupqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uupsvl(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); uupsvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_uupqin(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); uupqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uuinit(obj) VALUE obj; { uuinit_(); return Qnil; } static VALUE dcl_uuslnt(obj, itype) VALUE obj, itype; { integer i_itype; if ((TYPE(itype) != T_BIGNUM) || (TYPE(itype) != T_FIXNUM)) { itype = rb_funcall(itype, rb_intern("to_i"), 0); } i_itype = NUM2INT(itype); uuslnt_(&i_itype); return Qnil; } static VALUE dcl_uuqlnt(obj) VALUE obj; { integer o_itype; VALUE itype; uuqlnt_(&o_itype); itype = INT2NUM(o_itype); return itype; } static VALUE dcl_uuslni(obj, index) VALUE obj, index; { integer i_index; if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } i_index = NUM2INT(index); uuslni_(&i_index); return Qnil; } static VALUE dcl_uuqlni(obj) VALUE obj; { integer o_index; VALUE index; uuqlni_(&o_index); index = INT2NUM(o_index); return index; } static VALUE dcl_uusmkt(obj, itype) VALUE obj, itype; { integer i_itype; if ((TYPE(itype) != T_BIGNUM) || (TYPE(itype) != T_FIXNUM)) { itype = rb_funcall(itype, rb_intern("to_i"), 0); } i_itype = NUM2INT(itype); uusmkt_(&i_itype); return Qnil; } static VALUE dcl_uuqmkt(obj) VALUE obj; { integer o_itype; VALUE itype; uuqmkt_(&o_itype); itype = INT2NUM(o_itype); return itype; } static VALUE dcl_uusmki(obj, index) VALUE obj, index; { integer i_index; if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } i_index = NUM2INT(index); uusmki_(&i_index); return Qnil; } static VALUE dcl_uuqmki(obj) VALUE obj; { integer o_index; VALUE index; uuqmki_(&o_index); index = INT2NUM(o_index); return index; } static VALUE dcl_uusmks(obj, rsize) VALUE obj, rsize; { real i_rsize; if (TYPE(rsize) != T_FLOAT) { rsize = rb_funcall(rsize, rb_intern("to_f"), 0); } i_rsize = (real)NUM2DBL(rsize); uusmks_(&i_rsize); return Qnil; } static VALUE dcl_uuqmks(obj) VALUE obj; { real o_rsize; VALUE rsize; uuqmks_(&o_rsize); rsize = rb_float_new((double)o_rsize); return rsize; } static VALUE dcl_uusebt(obj, itype) VALUE obj, itype; { integer i_itype; if ((TYPE(itype) != T_BIGNUM) || (TYPE(itype) != T_FIXNUM)) { itype = rb_funcall(itype, rb_intern("to_i"), 0); } i_itype = NUM2INT(itype); uusebt_(&i_itype); return Qnil; } static VALUE dcl_uuqebt(obj) VALUE obj; { integer o_itype; VALUE itype; uuqebt_(&o_itype); itype = INT2NUM(o_itype); return itype; } static VALUE dcl_uusebi(obj, index) VALUE obj, index; { integer i_index; if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } i_index = NUM2INT(index); uusebi_(&i_index); return Qnil; } static VALUE dcl_uuqebi(obj) VALUE obj; { integer o_index; VALUE index; uuqebi_(&o_index); index = INT2NUM(o_index); return index; } static VALUE dcl_uusebs(obj, rsize) VALUE obj, rsize; { real i_rsize; if (TYPE(rsize) != T_FLOAT) { rsize = rb_funcall(rsize, rb_intern("to_f"), 0); } i_rsize = (real)NUM2DBL(rsize); uusebs_(&i_rsize); return Qnil; } static VALUE dcl_uuqebs(obj) VALUE obj; { real o_rsize; VALUE rsize; uuqebs_(&o_rsize); rsize = rb_float_new((double)o_rsize); return rsize; } static VALUE dcl_uusbrs(obj, rsize) VALUE obj, rsize; { real i_rsize; if (TYPE(rsize) != T_FLOAT) { rsize = rb_funcall(rsize, rb_intern("to_f"), 0); } i_rsize = (real)NUM2DBL(rsize); uusbrs_(&i_rsize); return Qnil; } static VALUE dcl_uuqbrs(obj) VALUE obj; { real o_rsize; VALUE rsize; uuqbrs_(&o_rsize); rsize = rb_float_new((double)o_rsize); return rsize; } static VALUE dcl_uusfrt(obj, itype) VALUE obj, itype; { integer i_itype; if ((TYPE(itype) != T_BIGNUM) || (TYPE(itype) != T_FIXNUM)) { itype = rb_funcall(itype, rb_intern("to_i"), 0); } i_itype = NUM2INT(itype); uusfrt_(&i_itype); return Qnil; } static VALUE dcl_uuqfrt(obj) VALUE obj; { integer o_itype; VALUE itype; uuqfrt_(&o_itype); itype = INT2NUM(o_itype); return itype; } static VALUE dcl_uusfri(obj, index) VALUE obj, index; { integer i_index; if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } i_index = NUM2INT(index); uusfri_(&i_index); return Qnil; } static VALUE dcl_uuqfri(obj) VALUE obj; { integer o_index; VALUE index; uuqfri_(&o_index); index = INT2NUM(o_index); return index; } static VALUE dcl_uusarp(obj, itpt1, itpt2) VALUE obj, itpt1, itpt2; { integer i_itpt1; integer i_itpt2; if ((TYPE(itpt1) != T_BIGNUM) || (TYPE(itpt1) != T_FIXNUM)) { itpt1 = rb_funcall(itpt1, rb_intern("to_i"), 0); } if ((TYPE(itpt2) != T_BIGNUM) || (TYPE(itpt2) != T_FIXNUM)) { itpt2 = rb_funcall(itpt2, rb_intern("to_i"), 0); } i_itpt1 = NUM2INT(itpt1); i_itpt2 = NUM2INT(itpt2); uusarp_(&i_itpt1, &i_itpt2); return Qnil; } static VALUE dcl_uuqarp(obj) VALUE obj; { integer o_itpt1; integer o_itpt2; VALUE itpt1; VALUE itpt2; uuqarp_(&o_itpt1, &o_itpt2); itpt1 = INT2NUM(o_itpt1); itpt2 = INT2NUM(o_itpt2); return rb_ary_new3(2, itpt1, itpt2); } static VALUE dcl_uusidv(obj, umin, umax) VALUE obj, umin, umax; { real i_umin; real i_umax; 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); } i_umin = (real)NUM2DBL(umin); i_umax = (real)NUM2DBL(umax); uusidv_(&i_umin, &i_umax); return Qnil; } static VALUE dcl_uuqidv(obj) VALUE obj; { real o_umin; real o_umax; VALUE umin; VALUE umax; uuqidv_(&o_umin, &o_umax); umin = rb_float_new((double)o_umin); umax = rb_float_new((double)o_umax); return rb_ary_new3(2, umin, umax); } static VALUE dcl_uuiget(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); uuiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp)); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uuiset(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); uuiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uuistx(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); uuistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uuiqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uuiqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uuiqid(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); uuiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uuiqcp(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); uuiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uuiqcl(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); uuiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uuiqvl(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); uuiqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uuisvl(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); uuisvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_uuiqin(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); uuiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uulget(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); uulget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp)); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uulset(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_; uulset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uulstx(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_; uulstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uulqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uulqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uulqid(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); uulqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uulqcp(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); uulqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uulqcl(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); uulqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uulqvl(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); uulqvl_(&i_idx, &o_lpara); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uulsvl(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_; uulsvl_(&i_idx, &i_lpara); return Qnil; } static VALUE dcl_uulqin(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); uulqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uurget(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); uurget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp)); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_uurset(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); uurset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uurstx(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); uurstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uurqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uurqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uurqid(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); uurqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uurqcp(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); uurqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uurqcl(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); uurqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uurqvl(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); uurqvl_(&i_idx, &o_rpara); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_uursvl(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); uursvl_(&i_idx, &i_rpara); return Qnil; } static VALUE dcl_uurqin(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); uurqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } void init_grph2_uupack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "uulin", dcl_uulin, 3); rb_define_module_function(mDCL, "uulinz", dcl_uulinz, 5); rb_define_module_function(mDCL, "uumrk", dcl_uumrk, 3); rb_define_module_function(mDCL, "uumrkz", dcl_uumrkz, 6); rb_define_module_function(mDCL, "uupqnp", dcl_uupqnp, 0); rb_define_module_function(mDCL, "uupqid", dcl_uupqid, 1); rb_define_module_function(mDCL, "uupqcp", dcl_uupqcp, 1); rb_define_module_function(mDCL, "uupqcl", dcl_uupqcl, 1); rb_define_module_function(mDCL, "uupqit", dcl_uupqit, 1); rb_define_module_function(mDCL, "uupqvl", dcl_uupqvl, 1); rb_define_module_function(mDCL, "uupsvl", dcl_uupsvl, 2); rb_define_module_function(mDCL, "uupqin", dcl_uupqin, 1); rb_define_module_function(mDCL, "uuinit", dcl_uuinit, 0); rb_define_module_function(mDCL, "uuslnt", dcl_uuslnt, 1); rb_define_module_function(mDCL, "uuqlnt", dcl_uuqlnt, 0); rb_define_module_function(mDCL, "uuslni", dcl_uuslni, 1); rb_define_module_function(mDCL, "uuqlni", dcl_uuqlni, 0); rb_define_module_function(mDCL, "uusmkt", dcl_uusmkt, 1); rb_define_module_function(mDCL, "uuqmkt", dcl_uuqmkt, 0); rb_define_module_function(mDCL, "uusmki", dcl_uusmki, 1); rb_define_module_function(mDCL, "uuqmki", dcl_uuqmki, 0); rb_define_module_function(mDCL, "uusmks", dcl_uusmks, 1); rb_define_module_function(mDCL, "uuqmks", dcl_uuqmks, 0); rb_define_module_function(mDCL, "uusebt", dcl_uusebt, 1); rb_define_module_function(mDCL, "uuqebt", dcl_uuqebt, 0); rb_define_module_function(mDCL, "uusebi", dcl_uusebi, 1); rb_define_module_function(mDCL, "uuqebi", dcl_uuqebi, 0); rb_define_module_function(mDCL, "uusebs", dcl_uusebs, 1); rb_define_module_function(mDCL, "uuqebs", dcl_uuqebs, 0); rb_define_module_function(mDCL, "uusbrs", dcl_uusbrs, 1); rb_define_module_function(mDCL, "uuqbrs", dcl_uuqbrs, 0); rb_define_module_function(mDCL, "uusfrt", dcl_uusfrt, 1); rb_define_module_function(mDCL, "uuqfrt", dcl_uuqfrt, 0); rb_define_module_function(mDCL, "uusfri", dcl_uusfri, 1); rb_define_module_function(mDCL, "uuqfri", dcl_uuqfri, 0); rb_define_module_function(mDCL, "uusarp", dcl_uusarp, 2); rb_define_module_function(mDCL, "uuqarp", dcl_uuqarp, 0); rb_define_module_function(mDCL, "uusidv", dcl_uusidv, 2); rb_define_module_function(mDCL, "uuqidv", dcl_uuqidv, 0); rb_define_module_function(mDCL, "uuiget", dcl_uuiget, 1); rb_define_module_function(mDCL, "uuiset", dcl_uuiset, 2); rb_define_module_function(mDCL, "uuistx", dcl_uuistx, 2); rb_define_module_function(mDCL, "uuiqnp", dcl_uuiqnp, 0); rb_define_module_function(mDCL, "uuiqid", dcl_uuiqid, 1); rb_define_module_function(mDCL, "uuiqcp", dcl_uuiqcp, 1); rb_define_module_function(mDCL, "uuiqcl", dcl_uuiqcl, 1); rb_define_module_function(mDCL, "uuiqvl", dcl_uuiqvl, 1); rb_define_module_function(mDCL, "uuisvl", dcl_uuisvl, 2); rb_define_module_function(mDCL, "uuiqin", dcl_uuiqin, 1); rb_define_module_function(mDCL, "uulget", dcl_uulget, 1); rb_define_module_function(mDCL, "uulset", dcl_uulset, 2); rb_define_module_function(mDCL, "uulstx", dcl_uulstx, 2); rb_define_module_function(mDCL, "uulqnp", dcl_uulqnp, 0); rb_define_module_function(mDCL, "uulqid", dcl_uulqid, 1); rb_define_module_function(mDCL, "uulqcp", dcl_uulqcp, 1); rb_define_module_function(mDCL, "uulqcl", dcl_uulqcl, 1); rb_define_module_function(mDCL, "uulqvl", dcl_uulqvl, 1); rb_define_module_function(mDCL, "uulsvl", dcl_uulsvl, 2); rb_define_module_function(mDCL, "uulqin", dcl_uulqin, 1); rb_define_module_function(mDCL, "uurget", dcl_uurget, 1); rb_define_module_function(mDCL, "uurset", dcl_uurset, 2); rb_define_module_function(mDCL, "uurstx", dcl_uurstx, 2); rb_define_module_function(mDCL, "uurqnp", dcl_uurqnp, 0); rb_define_module_function(mDCL, "uurqid", dcl_uurqid, 1); rb_define_module_function(mDCL, "uurqcp", dcl_uurqcp, 1); rb_define_module_function(mDCL, "uurqcl", dcl_uurqcl, 1); rb_define_module_function(mDCL, "uurqvl", dcl_uurqvl, 1); rb_define_module_function(mDCL, "uursvl", dcl_uursvl, 2); rb_define_module_function(mDCL, "uurqin", dcl_uurqin, 1); }