/* * $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_umpmap(obj, cdsn) VALUE obj, cdsn; { char *i_cdsn; if (TYPE(cdsn) != T_STRING) { cdsn = rb_funcall(cdsn, rb_intern("to_str"), 0); } i_cdsn = STR2CSTR(cdsn); umpmap_(i_cdsn, (ftnlen)strlen(i_cdsn)); return Qnil; } static VALUE dcl_umqfnm(obj, cpara) VALUE obj, cpara; { char *i_cpara; char *o_cfname; VALUE cfname; if (TYPE(cpara) != T_STRING) { cpara = rb_funcall(cpara, rb_intern("to_str"), 0); } i_cpara = STR2CSTR(cpara); o_cfname= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cfname, '\0', DFLT_SIZE+1); umqfnm_(i_cpara, o_cfname, (ftnlen)strlen(i_cpara), (ftnlen)DFLT_SIZE); cfname = rb_str_new2(o_cfname); return cfname; } static VALUE dcl_umpglb(obj) VALUE obj; { umpglb_(); return Qnil; } static VALUE dcl_umpgrd(obj) VALUE obj; { umpgrd_(); return Qnil; } static VALUE dcl_umplim(obj) VALUE obj; { umplim_(); return Qnil; } static VALUE dcl_uminit(obj) VALUE obj; { uminit_(); return Qnil; } static VALUE dcl_umscnt(obj, xcnt, ycnt, rot) VALUE obj, xcnt, ycnt, rot; { real i_xcnt; real i_ycnt; real i_rot; if (TYPE(xcnt) != T_FLOAT) { xcnt = rb_funcall(xcnt, rb_intern("to_f"), 0); } if (TYPE(ycnt) != T_FLOAT) { ycnt = rb_funcall(ycnt, rb_intern("to_f"), 0); } if (TYPE(rot) != T_FLOAT) { rot = rb_funcall(rot, rb_intern("to_f"), 0); } i_xcnt = (real)NUM2DBL(xcnt); i_ycnt = (real)NUM2DBL(ycnt); i_rot = (real)NUM2DBL(rot); umscnt_(&i_xcnt, &i_ycnt, &i_rot); return Qnil; } static VALUE dcl_umqcnt(obj) VALUE obj; { real o_xcnt; real o_ycnt; real o_rot; VALUE xcnt; VALUE ycnt; VALUE rot; umqcnt_(&o_xcnt, &o_ycnt, &o_rot); xcnt = rb_float_new((double)o_xcnt); ycnt = rb_float_new((double)o_ycnt); rot = rb_float_new((double)o_rot); return rb_ary_new3(3, xcnt, ycnt, rot); } static VALUE dcl_umscwd(obj, xcntr, ycntr, r) VALUE obj, xcntr, ycntr, r; { real i_xcntr; real i_ycntr; real i_r; if (TYPE(xcntr) != T_FLOAT) { xcntr = rb_funcall(xcntr, rb_intern("to_f"), 0); } if (TYPE(ycntr) != T_FLOAT) { ycntr = rb_funcall(ycntr, rb_intern("to_f"), 0); } if (TYPE(r) != T_FLOAT) { r = rb_funcall(r, rb_intern("to_f"), 0); } i_xcntr = (real)NUM2DBL(xcntr); i_ycntr = (real)NUM2DBL(ycntr); i_r = (real)NUM2DBL(r); umscwd_(&i_xcntr, &i_ycntr, &i_r); return Qnil; } static VALUE dcl_umqcwd(obj) VALUE obj; { real o_xcntr; real o_ycntr; real o_r; VALUE xcntr; VALUE ycntr; VALUE r; umqcwd_(&o_xcntr, &o_ycntr, &o_r); xcntr = rb_float_new((double)o_xcntr); ycntr = rb_float_new((double)o_ycntr); r = rb_float_new((double)o_r); return rb_ary_new3(3, xcntr, ycntr, r); } static VALUE dcl_umspnt(obj, n, ux, uy) VALUE obj, n, ux, uy; { integer i_n; real *i_ux; real *i_uy; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(ux) == T_FLOAT) { ux = rb_Array(ux); } /* if ((TYPE(ux) != T_ARRAY) && (rb_obj_is_kind_of(ux, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(uy) == T_FLOAT) { uy = rb_Array(uy); } /* if ((TYPE(uy) != T_ARRAY) && (rb_obj_is_kind_of(uy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_n = NUM2INT(n); i_ux = dcl_obj2crealary(ux); i_uy = dcl_obj2crealary(uy); umspnt_(&i_n, i_ux, i_uy); dcl_freecrealary(i_ux); dcl_freecrealary(i_uy); return Qnil; } static VALUE dcl_umqpnt(obj, n) VALUE obj, n; { integer i_n; real o_uxa; real o_uya; VALUE uxa; VALUE uya; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } i_n = NUM2INT(n); umqpnt_(&i_n, &o_uxa, &o_uya); uxa = rb_float_new((double)o_uxa); uya = rb_float_new((double)o_uya); return rb_ary_new3(2, uxa, uya); } static VALUE dcl_umqptn(obj) VALUE obj; { integer o_n; VALUE n; umqptn_(&o_n); n = INT2NUM(o_n); return n; } static VALUE dcl_umrpnt(obj) VALUE obj; { umrpnt_(); return Qnil; } static VALUE dcl_umpfit(obj) VALUE obj; { umpfit_(); return Qnil; } static VALUE dcl_umpqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; umpqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_umpqid(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); umpqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_umpqcp(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); umpqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umpqcl(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); umpqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umpqit(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); umpqit_(&i_idx, &o_itp); itp = INT2NUM(o_itp); return itp; } static VALUE dcl_umpqvl(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); umpqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_umpsvl(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); umpsvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_umpqin(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); umpqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_umspct(obj) VALUE obj; { umspct_(); return Qnil; } static VALUE dcl_umspcw(obj) VALUE obj; { umspcw_(); return Qnil; } static VALUE dcl_umspwd(obj) VALUE obj; { umspwd_(); return Qnil; } static VALUE dcl_umsppt(obj) VALUE obj; { umsppt_(); return Qnil; } static VALUE dcl_umspdf(obj) VALUE obj; { umspdf_(); return Qnil; } static VALUE dcl_umbndc(obj, xmin) VALUE obj, xmin; { real io_xmin; real o_xmax; real o_ymin; real o_ymax; VALUE xmax; VALUE ymin; VALUE ymax; if (TYPE(xmin) != T_FLOAT) { xmin = rb_funcall(xmin, rb_intern("to_f"), 0); } io_xmin = (real)NUM2DBL(xmin); umbndc_(&io_xmin, &o_xmax, &o_ymin, &o_ymax); xmin = rb_float_new((double)io_xmin); xmax = rb_float_new((double)o_xmax); ymin = rb_float_new((double)o_ymin); ymax = rb_float_new((double)o_ymax); return rb_ary_new3(4, xmin, xmax, ymin, ymax); } static VALUE dcl_umbndp(obj, vxmin) VALUE obj, vxmin; { real io_vxmin; real o_vxmax; real o_vymin; real o_vymax; VALUE vxmax; VALUE vymin; VALUE vymax; if (TYPE(vxmin) != T_FLOAT) { vxmin = rb_funcall(vxmin, rb_intern("to_f"), 0); } io_vxmin = (real)NUM2DBL(vxmin); umbndp_(&io_vxmin, &o_vxmax, &o_vymin, &o_vymax); vxmin = rb_float_new((double)io_vxmin); vxmax = rb_float_new((double)o_vxmax); vymin = rb_float_new((double)o_vymin); vymax = rb_float_new((double)o_vymax); return rb_ary_new3(4, vxmin, vxmax, vymin, vymax); } static VALUE dcl_umbndr(obj, func, ftr) VALUE obj, func, ftr; { real i_func; real i_ftr; real o_xmin; real o_xmax; real o_ymin; real o_ymax; VALUE xmin; VALUE xmax; VALUE ymin; VALUE ymax; if (TYPE(func) != T_FLOAT) { func = rb_funcall(func, rb_intern("to_f"), 0); } if (TYPE(ftr) != T_FLOAT) { ftr = rb_funcall(ftr, rb_intern("to_f"), 0); } i_func = (real)NUM2DBL(func); i_ftr = (real)NUM2DBL(ftr); umbndr_(&i_func, &i_ftr, &o_xmin, &o_xmax, &o_ymin, &o_ymax); xmin = rb_float_new((double)o_xmin); xmax = rb_float_new((double)o_xmax); ymin = rb_float_new((double)o_ymin); ymax = rb_float_new((double)o_ymax); return rb_ary_new3(4, xmin, xmax, ymin, ymax); } static VALUE dcl_umqtxy(obj) VALUE obj; { real o_txminz; real o_txmaxz; real o_tyminz; real o_tymaxz; VALUE txminz; VALUE txmaxz; VALUE tyminz; VALUE tymaxz; umqtxy_(&o_txminz, &o_txmaxz, &o_tyminz, &o_tymaxz); txminz = rb_float_new((double)o_txminz); txmaxz = rb_float_new((double)o_txmaxz); tyminz = rb_float_new((double)o_tyminz); tymaxz = rb_float_new((double)o_tymaxz); return rb_ary_new3(4, txminz, txmaxz, tyminz, tymaxz); } static VALUE dcl_umstvz(obj) VALUE obj; { umstvz_(); return Qnil; } static VALUE dcl_umsgrd(obj) VALUE obj; { umsgrd_(); return Qnil; } static VALUE dcl_umscom(obj) VALUE obj; { umscom_(); return Qnil; } static VALUE dcl_umiget(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); umiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp)); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_umiset(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); umiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_umistx(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); umistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_umiqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; umiqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_umiqid(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); umiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_umiqcp(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); umiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umiqcl(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); umiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umiqvl(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); umiqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_umisvl(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); umisvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_umiqin(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); umiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_umlget(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); umlget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp)); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_umlset(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_; umlset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_umlstx(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_; umlstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_umlqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; umlqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_umlqid(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); umlqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_umlqcp(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); umlqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umlqcl(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); umlqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umlqvl(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); umlqvl_(&i_idx, &o_lpara); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_umlsvl(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_; umlsvl_(&i_idx, &i_lpara); return Qnil; } static VALUE dcl_umlqin(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); umlqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_umrget(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); umrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp)); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_umrset(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); umrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_umrstx(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); umrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_umrqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; umrqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_umrqid(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); umrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_umrqcp(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); umrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umrqcl(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); umrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_umrqvl(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); umrqvl_(&i_idx, &o_rpara); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_umrsvl(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); umrsvl_(&i_idx, &i_rpara); return Qnil; } static VALUE dcl_umrqin(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); umrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } #if DCLVER >= 53 static VALUE dcl_umfmap(obj, cdsn) VALUE obj, cdsn; { char *i_cdsn; if (TYPE(cdsn) != T_STRING) { cdsn = rb_funcall(cdsn, rb_intern("to_str"), 0); } i_cdsn = STR2CSTR(cdsn); umfmap_(i_cdsn, (ftnlen)strlen(i_cdsn)); return Qnil; } #endif void init_grph2_umpack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "umpmap", dcl_umpmap, 1); rb_define_module_function(mDCL, "umqfnm", dcl_umqfnm, 1); rb_define_module_function(mDCL, "umpglb", dcl_umpglb, 0); rb_define_module_function(mDCL, "umpgrd", dcl_umpgrd, 0); rb_define_module_function(mDCL, "umplim", dcl_umplim, 0); rb_define_module_function(mDCL, "uminit", dcl_uminit, 0); rb_define_module_function(mDCL, "umscnt", dcl_umscnt, 3); rb_define_module_function(mDCL, "umqcnt", dcl_umqcnt, 0); rb_define_module_function(mDCL, "umscwd", dcl_umscwd, 3); rb_define_module_function(mDCL, "umqcwd", dcl_umqcwd, 0); rb_define_module_function(mDCL, "umspnt", dcl_umspnt, 3); rb_define_module_function(mDCL, "umqpnt", dcl_umqpnt, 1); rb_define_module_function(mDCL, "umqptn", dcl_umqptn, 0); rb_define_module_function(mDCL, "umrpnt", dcl_umrpnt, 0); rb_define_module_function(mDCL, "umpfit", dcl_umpfit, 0); rb_define_module_function(mDCL, "umpqnp", dcl_umpqnp, 0); rb_define_module_function(mDCL, "umpqid", dcl_umpqid, 1); rb_define_module_function(mDCL, "umpqcp", dcl_umpqcp, 1); rb_define_module_function(mDCL, "umpqcl", dcl_umpqcl, 1); rb_define_module_function(mDCL, "umpqit", dcl_umpqit, 1); rb_define_module_function(mDCL, "umpqvl", dcl_umpqvl, 1); rb_define_module_function(mDCL, "umpsvl", dcl_umpsvl, 2); rb_define_module_function(mDCL, "umpqin", dcl_umpqin, 1); rb_define_module_function(mDCL, "umspct", dcl_umspct, 0); rb_define_module_function(mDCL, "umspcw", dcl_umspcw, 0); rb_define_module_function(mDCL, "umspwd", dcl_umspwd, 0); rb_define_module_function(mDCL, "umsppt", dcl_umsppt, 0); rb_define_module_function(mDCL, "umspdf", dcl_umspdf, 0); rb_define_module_function(mDCL, "umbndc", dcl_umbndc, 1); rb_define_module_function(mDCL, "umbndp", dcl_umbndp, 1); rb_define_module_function(mDCL, "umbndr", dcl_umbndr, 2); rb_define_module_function(mDCL, "umqtxy", dcl_umqtxy, 0); rb_define_module_function(mDCL, "umstvz", dcl_umstvz, 0); rb_define_module_function(mDCL, "umsgrd", dcl_umsgrd, 0); rb_define_module_function(mDCL, "umscom", dcl_umscom, 0); rb_define_module_function(mDCL, "umiget", dcl_umiget, 1); rb_define_module_function(mDCL, "umiset", dcl_umiset, 2); rb_define_module_function(mDCL, "umistx", dcl_umistx, 2); rb_define_module_function(mDCL, "umiqnp", dcl_umiqnp, 0); rb_define_module_function(mDCL, "umiqid", dcl_umiqid, 1); rb_define_module_function(mDCL, "umiqcp", dcl_umiqcp, 1); rb_define_module_function(mDCL, "umiqcl", dcl_umiqcl, 1); rb_define_module_function(mDCL, "umiqvl", dcl_umiqvl, 1); rb_define_module_function(mDCL, "umisvl", dcl_umisvl, 2); rb_define_module_function(mDCL, "umiqin", dcl_umiqin, 1); rb_define_module_function(mDCL, "umlget", dcl_umlget, 1); rb_define_module_function(mDCL, "umlset", dcl_umlset, 2); rb_define_module_function(mDCL, "umlstx", dcl_umlstx, 2); rb_define_module_function(mDCL, "umlqnp", dcl_umlqnp, 0); rb_define_module_function(mDCL, "umlqid", dcl_umlqid, 1); rb_define_module_function(mDCL, "umlqcp", dcl_umlqcp, 1); rb_define_module_function(mDCL, "umlqcl", dcl_umlqcl, 1); rb_define_module_function(mDCL, "umlqvl", dcl_umlqvl, 1); rb_define_module_function(mDCL, "umlsvl", dcl_umlsvl, 2); rb_define_module_function(mDCL, "umlqin", dcl_umlqin, 1); rb_define_module_function(mDCL, "umrget", dcl_umrget, 1); rb_define_module_function(mDCL, "umrset", dcl_umrset, 2); rb_define_module_function(mDCL, "umrstx", dcl_umrstx, 2); rb_define_module_function(mDCL, "umrqnp", dcl_umrqnp, 0); rb_define_module_function(mDCL, "umrqid", dcl_umrqid, 1); rb_define_module_function(mDCL, "umrqcp", dcl_umrqcp, 1); rb_define_module_function(mDCL, "umrqcl", dcl_umrqcl, 1); rb_define_module_function(mDCL, "umrqvl", dcl_umrqvl, 1); rb_define_module_function(mDCL, "umrsvl", dcl_umrsvl, 2); rb_define_module_function(mDCL, "umrqin", dcl_umrqin, 1); #if DCLVER >= 53 rb_define_module_function(mDCL, "umfmap", dcl_umfmap, 1); #endif }