/* * $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_scsobj(obj, xobj3, yobj3, zobj3) VALUE obj, xobj3, yobj3, zobj3; { real i_xobj3; real i_yobj3; real i_zobj3; if (TYPE(xobj3) != T_FLOAT) { xobj3 = rb_funcall(xobj3, rb_intern("to_f"), 0); } if (TYPE(yobj3) != T_FLOAT) { yobj3 = rb_funcall(yobj3, rb_intern("to_f"), 0); } if (TYPE(zobj3) != T_FLOAT) { zobj3 = rb_funcall(zobj3, rb_intern("to_f"), 0); } i_xobj3 = (real)NUM2DBL(xobj3); i_yobj3 = (real)NUM2DBL(yobj3); i_zobj3 = (real)NUM2DBL(zobj3); scsobj_(&i_xobj3, &i_yobj3, &i_zobj3); return Qnil; } static VALUE dcl_scqobj(obj) VALUE obj; { real o_xobj3; real o_yobj3; real o_zobj3; VALUE xobj3; VALUE yobj3; VALUE zobj3; scqobj_(&o_xobj3, &o_yobj3, &o_zobj3); xobj3 = rb_float_new((double)o_xobj3); yobj3 = rb_float_new((double)o_yobj3); zobj3 = rb_float_new((double)o_zobj3); return rb_ary_new3(3, xobj3, yobj3, zobj3); } static VALUE dcl_scseye(obj, xeye3, yeye3, zeye3) VALUE obj, xeye3, yeye3, zeye3; { real i_xeye3; real i_yeye3; real i_zeye3; if (TYPE(xeye3) != T_FLOAT) { xeye3 = rb_funcall(xeye3, rb_intern("to_f"), 0); } if (TYPE(yeye3) != T_FLOAT) { yeye3 = rb_funcall(yeye3, rb_intern("to_f"), 0); } if (TYPE(zeye3) != T_FLOAT) { zeye3 = rb_funcall(zeye3, rb_intern("to_f"), 0); } i_xeye3 = (real)NUM2DBL(xeye3); i_yeye3 = (real)NUM2DBL(yeye3); i_zeye3 = (real)NUM2DBL(zeye3); scseye_(&i_xeye3, &i_yeye3, &i_zeye3); return Qnil; } static VALUE dcl_scqeye(obj) VALUE obj; { real o_xeye3; real o_yeye3; real o_zeye3; VALUE xeye3; VALUE yeye3; VALUE zeye3; scqeye_(&o_xeye3, &o_yeye3, &o_zeye3); xeye3 = rb_float_new((double)o_xeye3); yeye3 = rb_float_new((double)o_yeye3); zeye3 = rb_float_new((double)o_zeye3); return rb_ary_new3(3, xeye3, yeye3, zeye3); } static VALUE dcl_scspln(obj, ixax, iyax, sect) VALUE obj, ixax, iyax, sect; { integer i_ixax; integer i_iyax; real i_sect; if ((TYPE(ixax) != T_BIGNUM) || (TYPE(ixax) != T_FIXNUM)) { ixax = rb_funcall(ixax, rb_intern("to_i"), 0); } if ((TYPE(iyax) != T_BIGNUM) || (TYPE(iyax) != T_FIXNUM)) { iyax = rb_funcall(iyax, rb_intern("to_i"), 0); } if (TYPE(sect) != T_FLOAT) { sect = rb_funcall(sect, rb_intern("to_f"), 0); } i_ixax = NUM2INT(ixax); i_iyax = NUM2INT(iyax); i_sect = (real)NUM2DBL(sect); scspln_(&i_ixax, &i_iyax, &i_sect); return Qnil; } static VALUE dcl_scqpln(obj) VALUE obj; { integer o_ixax; integer o_iyax; real o_sect; VALUE ixax; VALUE iyax; VALUE sect; scqpln_(&o_ixax, &o_iyax, &o_sect); ixax = INT2NUM(o_ixax); iyax = INT2NUM(o_iyax); sect = rb_float_new((double)o_sect); return rb_ary_new3(3, ixax, iyax, sect); } static VALUE dcl_scsprj(obj) VALUE obj; { scsprj_(); return Qnil; } static VALUE dcl_scsvpt(obj, vxmin, vxmax, vymin, vymax, vzmin, vzmax) VALUE obj, vxmin, vxmax, vymin, vymax, vzmin, vzmax; { real i_vxmin; real i_vxmax; real i_vymin; real i_vymax; real i_vzmin; real i_vzmax; if (TYPE(vxmin) != T_FLOAT) { vxmin = rb_funcall(vxmin, rb_intern("to_f"), 0); } if (TYPE(vxmax) != T_FLOAT) { vxmax = rb_funcall(vxmax, rb_intern("to_f"), 0); } if (TYPE(vymin) != T_FLOAT) { vymin = rb_funcall(vymin, rb_intern("to_f"), 0); } if (TYPE(vymax) != T_FLOAT) { vymax = rb_funcall(vymax, rb_intern("to_f"), 0); } if (TYPE(vzmin) != T_FLOAT) { vzmin = rb_funcall(vzmin, rb_intern("to_f"), 0); } if (TYPE(vzmax) != T_FLOAT) { vzmax = rb_funcall(vzmax, rb_intern("to_f"), 0); } i_vxmin = (real)NUM2DBL(vxmin); i_vxmax = (real)NUM2DBL(vxmax); i_vymin = (real)NUM2DBL(vymin); i_vymax = (real)NUM2DBL(vymax); i_vzmin = (real)NUM2DBL(vzmin); i_vzmax = (real)NUM2DBL(vzmax); scsvpt_(&i_vxmin, &i_vxmax, &i_vymin, &i_vymax, &i_vzmin, &i_vzmax); return Qnil; } static VALUE dcl_scqvpt(obj) VALUE obj; { real o_vxmin; real o_vxmax; real o_vymin; real o_vymax; real o_vzmin; real o_vzmax; VALUE vxmin; VALUE vxmax; VALUE vymin; VALUE vymax; VALUE vzmin; VALUE vzmax; scqvpt_(&o_vxmin, &o_vxmax, &o_vymin, &o_vymax, &o_vzmin, &o_vzmax); vxmin = rb_float_new((double)o_vxmin); vxmax = rb_float_new((double)o_vxmax); vymin = rb_float_new((double)o_vymin); vymax = rb_float_new((double)o_vymax); vzmin = rb_float_new((double)o_vzmin); vzmax = rb_float_new((double)o_vzmax); return rb_ary_new3(6, vxmin, vxmax, vymin, vymax, vzmin, vzmax); } static VALUE dcl_scswnd(obj, uxmin, uxmax, uymin, uymax, uzmin, uzmax) VALUE obj, uxmin, uxmax, uymin, uymax, uzmin, uzmax; { real i_uxmin; real i_uxmax; real i_uymin; real i_uymax; real i_uzmin; real i_uzmax; if (TYPE(uxmin) != T_FLOAT) { uxmin = rb_funcall(uxmin, rb_intern("to_f"), 0); } if (TYPE(uxmax) != T_FLOAT) { uxmax = rb_funcall(uxmax, rb_intern("to_f"), 0); } if (TYPE(uymin) != T_FLOAT) { uymin = rb_funcall(uymin, rb_intern("to_f"), 0); } if (TYPE(uymax) != T_FLOAT) { uymax = rb_funcall(uymax, rb_intern("to_f"), 0); } if (TYPE(uzmin) != T_FLOAT) { uzmin = rb_funcall(uzmin, rb_intern("to_f"), 0); } if (TYPE(uzmax) != T_FLOAT) { uzmax = rb_funcall(uzmax, rb_intern("to_f"), 0); } i_uxmin = (real)NUM2DBL(uxmin); i_uxmax = (real)NUM2DBL(uxmax); i_uymin = (real)NUM2DBL(uymin); i_uymax = (real)NUM2DBL(uymax); i_uzmin = (real)NUM2DBL(uzmin); i_uzmax = (real)NUM2DBL(uzmax); scswnd_(&i_uxmin, &i_uxmax, &i_uymin, &i_uymax, &i_uzmin, &i_uzmax); return Qnil; } static VALUE dcl_scqwnd(obj) VALUE obj; { real o_uxmin; real o_uxmax; real o_uymin; real o_uymax; real o_uzmin; real o_uzmax; VALUE uxmin; VALUE uxmax; VALUE uymin; VALUE uymax; VALUE uzmin; VALUE uzmax; scqwnd_(&o_uxmin, &o_uxmax, &o_uymin, &o_uymax, &o_uzmin, &o_uzmax); uxmin = rb_float_new((double)o_uxmin); uxmax = rb_float_new((double)o_uxmax); uymin = rb_float_new((double)o_uymin); uymax = rb_float_new((double)o_uymax); uzmin = rb_float_new((double)o_uzmin); uzmax = rb_float_new((double)o_uzmax); return rb_ary_new3(6, uxmin, uxmax, uymin, uymax, uzmin, uzmax); } static VALUE dcl_scslog(obj, lxlog3, lylog3, lzlog3) VALUE obj, lxlog3, lylog3, lzlog3; { logical i_lxlog3; logical i_lylog3; logical i_lzlog3; i_lxlog3 = ((lxlog3 == Qnil)||(lxlog3 == Qfalse)) ? FALSE_ : TRUE_; i_lylog3 = ((lylog3 == Qnil)||(lylog3 == Qfalse)) ? FALSE_ : TRUE_; i_lzlog3 = ((lzlog3 == Qnil)||(lzlog3 == Qfalse)) ? FALSE_ : TRUE_; scslog_(&i_lxlog3, &i_lylog3, &i_lzlog3); return Qnil; } static VALUE dcl_scqlog(obj) VALUE obj; { logical o_lxlog3; logical o_lylog3; logical o_lzlog3; VALUE lxlog3; VALUE lylog3; VALUE lzlog3; scqlog_(&o_lxlog3, &o_lylog3, &o_lzlog3); lxlog3 = (o_lxlog3 == FALSE_) ? Qfalse : Qtrue; lylog3 = (o_lylog3 == FALSE_) ? Qfalse : Qtrue; lzlog3 = (o_lzlog3 == FALSE_) ? Qfalse : Qtrue; return rb_ary_new3(3, lxlog3, lylog3, lzlog3); } static VALUE dcl_scsorg(obj, simfac, vxorg3, vyorg3, vzorg3) VALUE obj, simfac, vxorg3, vyorg3, vzorg3; { real i_simfac; real i_vxorg3; real i_vyorg3; real i_vzorg3; if (TYPE(simfac) != T_FLOAT) { simfac = rb_funcall(simfac, rb_intern("to_f"), 0); } if (TYPE(vxorg3) != T_FLOAT) { vxorg3 = rb_funcall(vxorg3, rb_intern("to_f"), 0); } if (TYPE(vyorg3) != T_FLOAT) { vyorg3 = rb_funcall(vyorg3, rb_intern("to_f"), 0); } if (TYPE(vzorg3) != T_FLOAT) { vzorg3 = rb_funcall(vzorg3, rb_intern("to_f"), 0); } i_simfac = (real)NUM2DBL(simfac); i_vxorg3 = (real)NUM2DBL(vxorg3); i_vyorg3 = (real)NUM2DBL(vyorg3); i_vzorg3 = (real)NUM2DBL(vzorg3); scsorg_(&i_simfac, &i_vxorg3, &i_vyorg3, &i_vzorg3); return Qnil; } static VALUE dcl_scqorg(obj) VALUE obj; { real o_simfac; real o_vxorg3; real o_vyorg3; real o_vzorg3; VALUE simfac; VALUE vxorg3; VALUE vyorg3; VALUE vzorg3; scqorg_(&o_simfac, &o_vxorg3, &o_vyorg3, &o_vzorg3); simfac = rb_float_new((double)o_simfac); vxorg3 = rb_float_new((double)o_vxorg3); vyorg3 = rb_float_new((double)o_vyorg3); vzorg3 = rb_float_new((double)o_vzorg3); return rb_ary_new3(4, simfac, vxorg3, vyorg3, vzorg3); } static VALUE dcl_scstrn(obj, itr3) VALUE obj, itr3; { integer i_itr3; if ((TYPE(itr3) != T_BIGNUM) || (TYPE(itr3) != T_FIXNUM)) { itr3 = rb_funcall(itr3, rb_intern("to_i"), 0); } i_itr3 = NUM2INT(itr3); scstrn_(&i_itr3); return Qnil; } static VALUE dcl_scqtrn(obj) VALUE obj; { integer o_itr3; VALUE itr3; scqtrn_(&o_itr3); itr3 = INT2NUM(o_itr3); return itr3; } static VALUE dcl_scstrf(obj) VALUE obj; { scstrf_(); return Qnil; } static VALUE dcl_scplu(obj, n, upx, upy, upz) VALUE obj, n, upx, upy, upz; { integer i_n; real *i_upx; real *i_upy; real *i_upz; 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(upz) == T_FLOAT) { upz = rb_Array(upz); } /* if ((TYPE(upz) != T_ARRAY) && (rb_obj_is_kind_of(upz, 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); i_upz = dcl_obj2crealary(upz); scplu_(&i_n, i_upx, i_upy, i_upz); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); dcl_freecrealary(i_upz); return Qnil; } static VALUE dcl_scplv(obj, n, vpx, vpy, vpz) VALUE obj, n, vpx, vpy, vpz; { integer i_n; real *i_vpx; real *i_vpy; real *i_vpz; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(vpx) == T_FLOAT) { vpx = rb_Array(vpx); } /* if ((TYPE(vpx) != T_ARRAY) && (rb_obj_is_kind_of(vpx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpy) == T_FLOAT) { vpy = rb_Array(vpy); } /* if ((TYPE(vpy) != T_ARRAY) && (rb_obj_is_kind_of(vpy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpz) == T_FLOAT) { vpz = rb_Array(vpz); } /* if ((TYPE(vpz) != T_ARRAY) && (rb_obj_is_kind_of(vpz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_n = NUM2INT(n); i_vpx = dcl_obj2crealary(vpx); i_vpy = dcl_obj2crealary(vpy); i_vpz = dcl_obj2crealary(vpz); scplv_(&i_n, i_vpx, i_vpy, i_vpz); dcl_freecrealary(i_vpx); dcl_freecrealary(i_vpy); dcl_freecrealary(i_vpz); return Qnil; } static VALUE dcl_scspli(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); scspli_(&i_index); return Qnil; } static VALUE dcl_scqpli(obj) VALUE obj; { integer o_index; VALUE index; scqpli_(&o_index); index = INT2NUM(o_index); return index; } static VALUE dcl_scplzu(obj, n, upx, upy, upz, index) VALUE obj, n, upx, upy, upz, index; { integer i_n; real *i_upx; real *i_upy; real *i_upz; 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(upz) == T_FLOAT) { upz = rb_Array(upz); } /* if ((TYPE(upz) != T_ARRAY) && (rb_obj_is_kind_of(upz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_index = NUM2INT(index); i_upx = dcl_obj2crealary(upx); i_upy = dcl_obj2crealary(upy); i_upz = dcl_obj2crealary(upz); scplzu_(&i_n, i_upx, i_upy, i_upz, &i_index); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); dcl_freecrealary(i_upz); return Qnil; } static VALUE dcl_scplzv(obj, n, vpx, vpy, vpz, index) VALUE obj, n, vpx, vpy, vpz, index; { integer i_n; real *i_vpx; real *i_vpy; real *i_vpz; integer i_index; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(vpx) == T_FLOAT) { vpx = rb_Array(vpx); } /* if ((TYPE(vpx) != T_ARRAY) && (rb_obj_is_kind_of(vpx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpy) == T_FLOAT) { vpy = rb_Array(vpy); } /* if ((TYPE(vpy) != T_ARRAY) && (rb_obj_is_kind_of(vpy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpz) == T_FLOAT) { vpz = rb_Array(vpz); } /* if ((TYPE(vpz) != T_ARRAY) && (rb_obj_is_kind_of(vpz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) { index = rb_funcall(index, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_index = NUM2INT(index); i_vpx = dcl_obj2crealary(vpx); i_vpy = dcl_obj2crealary(vpy); i_vpz = dcl_obj2crealary(vpz); scplzv_(&i_n, i_vpx, i_vpy, i_vpz, &i_index); dcl_freecrealary(i_vpx); dcl_freecrealary(i_vpy); dcl_freecrealary(i_vpz); return Qnil; } static VALUE dcl_scpmu(obj, n, upx, upy, upz) VALUE obj, n, upx, upy, upz; { integer i_n; real *i_upx; real *i_upy; real *i_upz; 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(upz) == T_FLOAT) { upz = rb_Array(upz); } /* if ((TYPE(upz) != T_ARRAY) && (rb_obj_is_kind_of(upz, 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); i_upz = dcl_obj2crealary(upz); scpmu_(&i_n, i_upx, i_upy, i_upz); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); dcl_freecrealary(i_upz); return Qnil; } static VALUE dcl_scpmv(obj, n, vpx, vpy, vpz) VALUE obj, n, vpx, vpy, vpz; { integer i_n; real *i_vpx; real *i_vpy; real *i_vpz; if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if (TYPE(vpx) == T_FLOAT) { vpx = rb_Array(vpx); } /* if ((TYPE(vpx) != T_ARRAY) && (rb_obj_is_kind_of(vpx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpy) == T_FLOAT) { vpy = rb_Array(vpy); } /* if ((TYPE(vpy) != T_ARRAY) && (rb_obj_is_kind_of(vpy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpz) == T_FLOAT) { vpz = rb_Array(vpz); } /* if ((TYPE(vpz) != T_ARRAY) && (rb_obj_is_kind_of(vpz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_n = NUM2INT(n); i_vpx = dcl_obj2crealary(vpx); i_vpy = dcl_obj2crealary(vpy); i_vpz = dcl_obj2crealary(vpz); scpmv_(&i_n, i_vpx, i_vpy, i_vpz); dcl_freecrealary(i_vpx); dcl_freecrealary(i_vpy); dcl_freecrealary(i_vpz); return Qnil; } static VALUE dcl_scspmt(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); scspmt_(&i_itype); return Qnil; } static VALUE dcl_scqpmt(obj) VALUE obj; { integer o_itype; VALUE itype; scqpmt_(&o_itype); itype = INT2NUM(o_itype); return itype; } static VALUE dcl_scspmi(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); scspmi_(&i_index); return Qnil; } static VALUE dcl_scqpmi(obj) VALUE obj; { integer o_index; VALUE index; scqpmi_(&o_index); index = INT2NUM(o_index); return index; } static VALUE dcl_scspms(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); scspms_(&i_rsize); return Qnil; } static VALUE dcl_scqpms(obj) VALUE obj; { real o_rsize; VALUE rsize; scqpms_(&o_rsize); rsize = rb_float_new((double)o_rsize); return rsize; } static VALUE dcl_scpmzu(obj, n, upx, upy, upz, itype, index, rsize) VALUE obj, n, upx, upy, upz, itype, index, rsize; { integer i_n; real *i_upx; real *i_upy; real *i_upz; 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(upz) == T_FLOAT) { upz = rb_Array(upz); } /* if ((TYPE(upz) != T_ARRAY) && (rb_obj_is_kind_of(upz, 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); i_upz = dcl_obj2crealary(upz); scpmzu_(&i_n, i_upx, i_upy, i_upz, &i_itype, &i_index, &i_rsize); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); dcl_freecrealary(i_upz); return Qnil; } static VALUE dcl_scpmzv(obj, n, vpx, vpy, vpz, itype, index, rsize) VALUE obj, n, vpx, vpy, vpz, itype, index, rsize; { integer i_n; real *i_vpx; real *i_vpy; real *i_vpz; 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(vpx) == T_FLOAT) { vpx = rb_Array(vpx); } /* if ((TYPE(vpx) != T_ARRAY) && (rb_obj_is_kind_of(vpx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpy) == T_FLOAT) { vpy = rb_Array(vpy); } /* if ((TYPE(vpy) != T_ARRAY) && (rb_obj_is_kind_of(vpy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpz) == T_FLOAT) { vpz = rb_Array(vpz); } /* if ((TYPE(vpz) != T_ARRAY) && (rb_obj_is_kind_of(vpz, 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_vpx = dcl_obj2crealary(vpx); i_vpy = dcl_obj2crealary(vpy); i_vpz = dcl_obj2crealary(vpz); scpmzv_(&i_n, i_vpx, i_vpy, i_vpz, &i_itype, &i_index, &i_rsize); dcl_freecrealary(i_vpx); dcl_freecrealary(i_vpy); dcl_freecrealary(i_vpz); return Qnil; } static VALUE dcl_sctnu(obj, upx, upy, upz) VALUE obj, upx, upy, upz; { real *i_upx; real *i_upy; real *i_upz; 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(upz) == T_FLOAT) { upz = rb_Array(upz); } /* if ((TYPE(upz) != T_ARRAY) && (rb_obj_is_kind_of(upz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_upx = dcl_obj2crealary(upx); i_upy = dcl_obj2crealary(upy); i_upz = dcl_obj2crealary(upz); sctnu_(i_upx, i_upy, i_upz); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); dcl_freecrealary(i_upz); return Qnil; } static VALUE dcl_sctnv(obj, vpx, vpy, vpz) VALUE obj, vpx, vpy, vpz; { real *i_vpx; real *i_vpy; real *i_vpz; if (TYPE(vpx) == T_FLOAT) { vpx = rb_Array(vpx); } /* if ((TYPE(vpx) != T_ARRAY) && (rb_obj_is_kind_of(vpx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpy) == T_FLOAT) { vpy = rb_Array(vpy); } /* if ((TYPE(vpy) != T_ARRAY) && (rb_obj_is_kind_of(vpy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpz) == T_FLOAT) { vpz = rb_Array(vpz); } /* if ((TYPE(vpz) != T_ARRAY) && (rb_obj_is_kind_of(vpz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_vpx = dcl_obj2crealary(vpx); i_vpy = dcl_obj2crealary(vpy); i_vpz = dcl_obj2crealary(vpz); sctnv_(i_vpx, i_vpy, i_vpz); dcl_freecrealary(i_vpx); dcl_freecrealary(i_vpy); dcl_freecrealary(i_vpz); return Qnil; } static VALUE dcl_scstnp(obj, itpat1, itpat2) VALUE obj, itpat1, itpat2; { integer i_itpat1; integer i_itpat2; if ((TYPE(itpat1) != T_BIGNUM) || (TYPE(itpat1) != T_FIXNUM)) { itpat1 = rb_funcall(itpat1, rb_intern("to_i"), 0); } if ((TYPE(itpat2) != T_BIGNUM) || (TYPE(itpat2) != T_FIXNUM)) { itpat2 = rb_funcall(itpat2, rb_intern("to_i"), 0); } i_itpat1 = NUM2INT(itpat1); i_itpat2 = NUM2INT(itpat2); scstnp_(&i_itpat1, &i_itpat2); return Qnil; } static VALUE dcl_scqtnp(obj) VALUE obj; { integer o_itpat1; integer o_itpat2; VALUE itpat1; VALUE itpat2; scqtnp_(&o_itpat1, &o_itpat2); itpat1 = INT2NUM(o_itpat1); itpat2 = INT2NUM(o_itpat2); return rb_ary_new3(2, itpat1, itpat2); } static VALUE dcl_sctnzu(obj, upx, upy, upz, itpat1, itpat2) VALUE obj, upx, upy, upz, itpat1, itpat2; { real *i_upx; real *i_upy; real *i_upz; integer i_itpat1; integer i_itpat2; 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(upz) == T_FLOAT) { upz = rb_Array(upz); } /* if ((TYPE(upz) != T_ARRAY) && (rb_obj_is_kind_of(upz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(itpat1) != T_BIGNUM) || (TYPE(itpat1) != T_FIXNUM)) { itpat1 = rb_funcall(itpat1, rb_intern("to_i"), 0); } if ((TYPE(itpat2) != T_BIGNUM) || (TYPE(itpat2) != T_FIXNUM)) { itpat2 = rb_funcall(itpat2, rb_intern("to_i"), 0); } i_itpat1 = NUM2INT(itpat1); i_itpat2 = NUM2INT(itpat2); i_upx = dcl_obj2crealary(upx); i_upy = dcl_obj2crealary(upy); i_upz = dcl_obj2crealary(upz); sctnzu_(i_upx, i_upy, i_upz, &i_itpat1, &i_itpat2); dcl_freecrealary(i_upx); dcl_freecrealary(i_upy); dcl_freecrealary(i_upz); return Qnil; } static VALUE dcl_sctnzv(obj, vpx, vpy, vpz, itpat1, itpat2) VALUE obj, vpx, vpy, vpz, itpat1, itpat2; { real *i_vpx; real *i_vpy; real *i_vpz; integer i_itpat1; integer i_itpat2; if (TYPE(vpx) == T_FLOAT) { vpx = rb_Array(vpx); } /* if ((TYPE(vpx) != T_ARRAY) && (rb_obj_is_kind_of(vpx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpy) == T_FLOAT) { vpy = rb_Array(vpy); } /* if ((TYPE(vpy) != T_ARRAY) && (rb_obj_is_kind_of(vpy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(vpz) == T_FLOAT) { vpz = rb_Array(vpz); } /* if ((TYPE(vpz) != T_ARRAY) && (rb_obj_is_kind_of(vpz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(itpat1) != T_BIGNUM) || (TYPE(itpat1) != T_FIXNUM)) { itpat1 = rb_funcall(itpat1, rb_intern("to_i"), 0); } if ((TYPE(itpat2) != T_BIGNUM) || (TYPE(itpat2) != T_FIXNUM)) { itpat2 = rb_funcall(itpat2, rb_intern("to_i"), 0); } i_itpat1 = NUM2INT(itpat1); i_itpat2 = NUM2INT(itpat2); i_vpx = dcl_obj2crealary(vpx); i_vpy = dcl_obj2crealary(vpy); i_vpz = dcl_obj2crealary(vpz); sctnzv_(i_vpx, i_vpy, i_vpz, &i_itpat1, &i_itpat2); dcl_freecrealary(i_vpx); dcl_freecrealary(i_vpy); dcl_freecrealary(i_vpz); return Qnil; } void init_grph1_scpack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "scsobj", dcl_scsobj, 3); rb_define_module_function(mDCL, "scqobj", dcl_scqobj, 0); rb_define_module_function(mDCL, "scseye", dcl_scseye, 3); rb_define_module_function(mDCL, "scqeye", dcl_scqeye, 0); rb_define_module_function(mDCL, "scspln", dcl_scspln, 3); rb_define_module_function(mDCL, "scqpln", dcl_scqpln, 0); rb_define_module_function(mDCL, "scsprj", dcl_scsprj, 0); rb_define_module_function(mDCL, "scsvpt", dcl_scsvpt, 6); rb_define_module_function(mDCL, "scqvpt", dcl_scqvpt, 0); rb_define_module_function(mDCL, "scswnd", dcl_scswnd, 6); rb_define_module_function(mDCL, "scqwnd", dcl_scqwnd, 0); rb_define_module_function(mDCL, "scslog", dcl_scslog, 3); rb_define_module_function(mDCL, "scqlog", dcl_scqlog, 0); rb_define_module_function(mDCL, "scsorg", dcl_scsorg, 4); rb_define_module_function(mDCL, "scqorg", dcl_scqorg, 0); rb_define_module_function(mDCL, "scstrn", dcl_scstrn, 1); rb_define_module_function(mDCL, "scqtrn", dcl_scqtrn, 0); rb_define_module_function(mDCL, "scstrf", dcl_scstrf, 0); rb_define_module_function(mDCL, "scplu", dcl_scplu, 4); rb_define_module_function(mDCL, "scplv", dcl_scplv, 4); rb_define_module_function(mDCL, "scspli", dcl_scspli, 1); rb_define_module_function(mDCL, "scqpli", dcl_scqpli, 0); rb_define_module_function(mDCL, "scplzu", dcl_scplzu, 5); rb_define_module_function(mDCL, "scplzv", dcl_scplzv, 5); rb_define_module_function(mDCL, "scpmu", dcl_scpmu, 4); rb_define_module_function(mDCL, "scpmv", dcl_scpmv, 4); rb_define_module_function(mDCL, "scspmt", dcl_scspmt, 1); rb_define_module_function(mDCL, "scqpmt", dcl_scqpmt, 0); rb_define_module_function(mDCL, "scspmi", dcl_scspmi, 1); rb_define_module_function(mDCL, "scqpmi", dcl_scqpmi, 0); rb_define_module_function(mDCL, "scspms", dcl_scspms, 1); rb_define_module_function(mDCL, "scqpms", dcl_scqpms, 0); rb_define_module_function(mDCL, "scpmzu", dcl_scpmzu, 7); rb_define_module_function(mDCL, "scpmzv", dcl_scpmzv, 7); rb_define_module_function(mDCL, "sctnu", dcl_sctnu, 3); rb_define_module_function(mDCL, "sctnv", dcl_sctnv, 3); rb_define_module_function(mDCL, "scstnp", dcl_scstnp, 2); rb_define_module_function(mDCL, "scqtnp", dcl_scqtnp, 0); rb_define_module_function(mDCL, "sctnzu", dcl_sctnzu, 5); rb_define_module_function(mDCL, "sctnzv", dcl_sctnzv, 5); }