/* * $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_stftrf(obj, ux, uy) VALUE obj, ux, uy; { real i_ux; real i_uy; real o_vx; real o_vy; VALUE vx; VALUE vy; if (TYPE(ux) != T_FLOAT) { ux = rb_funcall(ux, rb_intern("to_f"), 0); } if (TYPE(uy) != T_FLOAT) { uy = rb_funcall(uy, rb_intern("to_f"), 0); } i_ux = (real)NUM2DBL(ux); i_uy = (real)NUM2DBL(uy); stftrf_(&i_ux, &i_uy, &o_vx, &o_vy); vx = rb_float_new((double)o_vx); vy = rb_float_new((double)o_vy); return rb_ary_new3(2, vx, vy); } static VALUE dcl_stitrf(obj, vx, vy) VALUE obj, vx, vy; { real i_vx; real i_vy; real o_ux; real o_uy; VALUE ux; VALUE uy; if (TYPE(vx) != T_FLOAT) { vx = rb_funcall(vx, rb_intern("to_f"), 0); } if (TYPE(vy) != T_FLOAT) { vy = rb_funcall(vy, rb_intern("to_f"), 0); } i_vx = (real)NUM2DBL(vx); i_vy = (real)NUM2DBL(vy); stitrf_(&i_vx, &i_vy, &o_ux, &o_uy); ux = rb_float_new((double)o_ux); uy = rb_float_new((double)o_uy); return rb_ary_new3(2, ux, uy); } static VALUE dcl_stqtrf(obj) VALUE obj; { logical o_lmapa; VALUE lmapa; stqtrf_(&o_lmapa); lmapa = (o_lmapa == FALSE_) ? Qfalse : Qtrue; return lmapa; } static VALUE dcl_ststrf(obj, lmapa) VALUE obj, lmapa; { logical i_lmapa; i_lmapa = ((lmapa == Qnil)||(lmapa == Qfalse)) ? FALSE_ : TRUE_; ststrf_(&i_lmapa); return Qnil; } static VALUE dcl_stftrn(obj, ux, uy) VALUE obj, ux, uy; { real i_ux; real i_uy; real o_vx; real o_vy; VALUE vx; VALUE vy; if (TYPE(ux) != T_FLOAT) { ux = rb_funcall(ux, rb_intern("to_f"), 0); } if (TYPE(uy) != T_FLOAT) { uy = rb_funcall(uy, rb_intern("to_f"), 0); } i_ux = (real)NUM2DBL(ux); i_uy = (real)NUM2DBL(uy); stftrn_(&i_ux, &i_uy, &o_vx, &o_vy); vx = rb_float_new((double)o_vx); vy = rb_float_new((double)o_vy); return rb_ary_new3(2, vx, vy); } static VALUE dcl_stitrn(obj, vx, vy) VALUE obj, vx, vy; { real i_vx; real i_vy; real o_ux; real o_uy; VALUE ux; VALUE uy; if (TYPE(vx) != T_FLOAT) { vx = rb_funcall(vx, rb_intern("to_f"), 0); } if (TYPE(vy) != T_FLOAT) { vy = rb_funcall(vy, rb_intern("to_f"), 0); } i_vx = (real)NUM2DBL(vx); i_vy = (real)NUM2DBL(vy); stitrn_(&i_vx, &i_vy, &o_ux, &o_uy); ux = rb_float_new((double)o_ux); uy = rb_float_new((double)o_uy); return rb_ary_new3(2, ux, uy); } #if DCLVER >= 53 static VALUE dcl_ststri(obj, itr) VALUE obj, itr; { integer i_itr; if ((TYPE(itr) != T_BIGNUM) || (TYPE(itr) != T_FIXNUM)) { itr = rb_funcall(itr, rb_intern("to_i"), 0); } i_itr = NUM2INT(itr); ststri_(&i_itr); return Qnil; } #endif #if DCLVER >= 53 static VALUE dcl_ststrp(obj, cxa, cya, vxoff, vyoff) VALUE obj, cxa, cya, vxoff, vyoff; { real i_cxa; real i_cya; real i_vxoff; real i_vyoff; if (TYPE(cxa) != T_FLOAT) { cxa = rb_funcall(cxa, rb_intern("to_f"), 0); } if (TYPE(cya) != T_FLOAT) { cya = rb_funcall(cya, rb_intern("to_f"), 0); } if (TYPE(vxoff) != T_FLOAT) { vxoff = rb_funcall(vxoff, rb_intern("to_f"), 0); } if (TYPE(vyoff) != T_FLOAT) { vyoff = rb_funcall(vyoff, rb_intern("to_f"), 0); } i_cxa = (real)NUM2DBL(cxa); i_cya = (real)NUM2DBL(cya); i_vxoff = (real)NUM2DBL(vxoff); i_vyoff = (real)NUM2DBL(vyoff); ststrp_(&i_cxa, &i_cya, &i_vxoff, &i_vyoff); return Qnil; } #endif static VALUE dcl_ststrn(obj, itr, cxa, cya, vxoff, vyoff) VALUE obj, itr, cxa, cya, vxoff, vyoff; { integer i_itr; real i_cxa; real i_cya; real i_vxoff; real i_vyoff; if ((TYPE(itr) != T_BIGNUM) || (TYPE(itr) != T_FIXNUM)) { itr = rb_funcall(itr, rb_intern("to_i"), 0); } if (TYPE(cxa) != T_FLOAT) { cxa = rb_funcall(cxa, rb_intern("to_f"), 0); } if (TYPE(cya) != T_FLOAT) { cya = rb_funcall(cya, rb_intern("to_f"), 0); } if (TYPE(vxoff) != T_FLOAT) { vxoff = rb_funcall(vxoff, rb_intern("to_f"), 0); } if (TYPE(vyoff) != T_FLOAT) { vyoff = rb_funcall(vyoff, rb_intern("to_f"), 0); } i_itr = NUM2INT(itr); i_cxa = (real)NUM2DBL(cxa); i_cya = (real)NUM2DBL(cya); i_vxoff = (real)NUM2DBL(vxoff); i_vyoff = (real)NUM2DBL(vyoff); ststrn_(&i_itr, &i_cxa, &i_cya, &i_vxoff, &i_vyoff); return Qnil; } static VALUE dcl_stfrot(obj, ux, uy) VALUE obj, ux, uy; { real i_ux; real i_uy; real o_tx; real o_ty; VALUE tx; VALUE ty; if (TYPE(ux) != T_FLOAT) { ux = rb_funcall(ux, rb_intern("to_f"), 0); } if (TYPE(uy) != T_FLOAT) { uy = rb_funcall(uy, rb_intern("to_f"), 0); } i_ux = (real)NUM2DBL(ux); i_uy = (real)NUM2DBL(uy); stfrot_(&i_ux, &i_uy, &o_tx, &o_ty); tx = rb_float_new((double)o_tx); ty = rb_float_new((double)o_ty); return rb_ary_new3(2, tx, ty); } static VALUE dcl_stirot(obj, tx, ty) VALUE obj, tx, ty; { real i_tx; real i_ty; real o_ux; real o_uy; VALUE ux; VALUE uy; if (TYPE(tx) != T_FLOAT) { tx = rb_funcall(tx, rb_intern("to_f"), 0); } if (TYPE(ty) != T_FLOAT) { ty = rb_funcall(ty, rb_intern("to_f"), 0); } i_tx = (real)NUM2DBL(tx); i_ty = (real)NUM2DBL(ty); stirot_(&i_tx, &i_ty, &o_ux, &o_uy); ux = rb_float_new((double)o_ux); uy = rb_float_new((double)o_uy); return rb_ary_new3(2, ux, uy); } static VALUE dcl_stsrot(obj, theta, phi, psi) VALUE obj, theta, phi, psi; { real i_theta; real i_phi; real i_psi; if (TYPE(theta) != T_FLOAT) { theta = rb_funcall(theta, rb_intern("to_f"), 0); } if (TYPE(phi) != T_FLOAT) { phi = rb_funcall(phi, rb_intern("to_f"), 0); } if (TYPE(psi) != T_FLOAT) { psi = rb_funcall(psi, rb_intern("to_f"), 0); } i_theta = (real)NUM2DBL(theta); i_phi = (real)NUM2DBL(phi); i_psi = (real)NUM2DBL(psi); stsrot_(&i_theta, &i_phi, &i_psi); return Qnil; } static VALUE dcl_stfrad(obj, x, y) VALUE obj, x, y; { real i_x; real i_y; real o_rx; real o_ry; VALUE rx; VALUE ry; if (TYPE(x) != T_FLOAT) { x = rb_funcall(x, rb_intern("to_f"), 0); } if (TYPE(y) != T_FLOAT) { y = rb_funcall(y, rb_intern("to_f"), 0); } i_x = (real)NUM2DBL(x); i_y = (real)NUM2DBL(y); stfrad_(&i_x, &i_y, &o_rx, &o_ry); rx = rb_float_new((double)o_rx); ry = rb_float_new((double)o_ry); return rb_ary_new3(2, rx, ry); } static VALUE dcl_stirad(obj, rx, ry) VALUE obj, rx, ry; { real i_rx; real i_ry; real o_x; real o_y; VALUE x; VALUE y; if (TYPE(rx) != T_FLOAT) { rx = rb_funcall(rx, rb_intern("to_f"), 0); } if (TYPE(ry) != T_FLOAT) { ry = rb_funcall(ry, rb_intern("to_f"), 0); } i_rx = (real)NUM2DBL(rx); i_ry = (real)NUM2DBL(ry); stirad_(&i_rx, &i_ry, &o_x, &o_y); x = rb_float_new((double)o_x); y = rb_float_new((double)o_y); return rb_ary_new3(2, x, y); } static VALUE dcl_stsrad(obj, lxdeg, lydeg) VALUE obj, lxdeg, lydeg; { logical i_lxdeg; logical i_lydeg; i_lxdeg = ((lxdeg == Qnil)||(lxdeg == Qfalse)) ? FALSE_ : TRUE_; i_lydeg = ((lydeg == Qnil)||(lydeg == Qfalse)) ? FALSE_ : TRUE_; stsrad_(&i_lxdeg, &i_lydeg); return Qnil; } static VALUE dcl_stfusr(obj, ux, uy) VALUE obj, ux, uy; { real i_ux; real i_uy; real o_xx; real o_yy; VALUE xx; VALUE yy; if (TYPE(ux) != T_FLOAT) { ux = rb_funcall(ux, rb_intern("to_f"), 0); } if (TYPE(uy) != T_FLOAT) { uy = rb_funcall(uy, rb_intern("to_f"), 0); } i_ux = (real)NUM2DBL(ux); i_uy = (real)NUM2DBL(uy); stfusr_(&i_ux, &i_uy, &o_xx, &o_yy); xx = rb_float_new((double)o_xx); yy = rb_float_new((double)o_yy); return rb_ary_new3(2, xx, yy); } static VALUE dcl_stiusr(obj, xx, yy) VALUE obj, xx, yy; { real i_xx; real i_yy; real o_ux; real o_uy; VALUE ux; VALUE uy; if (TYPE(xx) != T_FLOAT) { xx = rb_funcall(xx, rb_intern("to_f"), 0); } if (TYPE(yy) != T_FLOAT) { yy = rb_funcall(yy, rb_intern("to_f"), 0); } i_xx = (real)NUM2DBL(xx); i_yy = (real)NUM2DBL(yy); stiusr_(&i_xx, &i_yy, &o_ux, &o_uy); ux = rb_float_new((double)o_ux); uy = rb_float_new((double)o_uy); return rb_ary_new3(2, ux, uy); } static VALUE dcl_stsusr(obj) VALUE obj; { stsusr_(); return Qnil; } static VALUE dcl_stfwtr(obj, rx, ry) VALUE obj, rx, ry; { real i_rx; real i_ry; real o_wx; real o_wy; VALUE wx; VALUE wy; if (TYPE(rx) != T_FLOAT) { rx = rb_funcall(rx, rb_intern("to_f"), 0); } if (TYPE(ry) != T_FLOAT) { ry = rb_funcall(ry, rb_intern("to_f"), 0); } i_rx = (real)NUM2DBL(rx); i_ry = (real)NUM2DBL(ry); stfwtr_(&i_rx, &i_ry, &o_wx, &o_wy); wx = rb_float_new((double)o_wx); wy = rb_float_new((double)o_wy); return rb_ary_new3(2, wx, wy); } static VALUE dcl_stiwtr(obj, wx, wy) VALUE obj, wx, wy; { real i_wx; real i_wy; real o_rx; real o_ry; VALUE rx; VALUE ry; if (TYPE(wx) != T_FLOAT) { wx = rb_funcall(wx, rb_intern("to_f"), 0); } if (TYPE(wy) != T_FLOAT) { wy = rb_funcall(wy, rb_intern("to_f"), 0); } i_wx = (real)NUM2DBL(wx); i_wy = (real)NUM2DBL(wy); stiwtr_(&i_wx, &i_wy, &o_rx, &o_ry); rx = rb_float_new((double)o_rx); ry = rb_float_new((double)o_ry); return rb_ary_new3(2, rx, ry); } static VALUE dcl_stswtr(obj, rxmin, rxmax, rymin, rymax, wxmin, wxmax, wymin, wymax, iwtrf) VALUE obj, rxmin, rxmax, rymin, rymax, wxmin, wxmax, wymin, wymax, iwtrf; { real i_rxmin; real i_rxmax; real i_rymin; real i_rymax; real i_wxmin; real i_wxmax; real i_wymin; real i_wymax; integer i_iwtrf; if (TYPE(rxmin) != T_FLOAT) { rxmin = rb_funcall(rxmin, rb_intern("to_f"), 0); } if (TYPE(rxmax) != T_FLOAT) { rxmax = rb_funcall(rxmax, rb_intern("to_f"), 0); } if (TYPE(rymin) != T_FLOAT) { rymin = rb_funcall(rymin, rb_intern("to_f"), 0); } if (TYPE(rymax) != T_FLOAT) { rymax = rb_funcall(rymax, rb_intern("to_f"), 0); } if (TYPE(wxmin) != T_FLOAT) { wxmin = rb_funcall(wxmin, rb_intern("to_f"), 0); } if (TYPE(wxmax) != T_FLOAT) { wxmax = rb_funcall(wxmax, rb_intern("to_f"), 0); } if (TYPE(wymin) != T_FLOAT) { wymin = rb_funcall(wymin, rb_intern("to_f"), 0); } if (TYPE(wymax) != T_FLOAT) { wymax = rb_funcall(wymax, rb_intern("to_f"), 0); } if ((TYPE(iwtrf) != T_BIGNUM) || (TYPE(iwtrf) != T_FIXNUM)) { iwtrf = rb_funcall(iwtrf, rb_intern("to_i"), 0); } i_rxmin = (real)NUM2DBL(rxmin); i_rxmax = (real)NUM2DBL(rxmax); i_rymin = (real)NUM2DBL(rymin); i_rymax = (real)NUM2DBL(rymax); i_wxmin = (real)NUM2DBL(wxmin); i_wxmax = (real)NUM2DBL(wxmax); i_wymin = (real)NUM2DBL(wymin); i_wymax = (real)NUM2DBL(wymax); i_iwtrf = NUM2INT(iwtrf); stswtr_(&i_rxmin, &i_rxmax, &i_rymin, &i_rymax, &i_wxmin, &i_wxmax, &i_wymin, &i_wymax, &i_iwtrf); return Qnil; } static VALUE dcl_stqwtr(obj) VALUE obj; { real o_rxmin; real o_rxmax; real o_rymin; real o_rymax; real o_wxmin; real o_wxmax; real o_wymin; real o_wymax; integer o_iwtrf; VALUE rxmin; VALUE rxmax; VALUE rymin; VALUE rymax; VALUE wxmin; VALUE wxmax; VALUE wymin; VALUE wymax; VALUE iwtrf; stqwtr_(&o_rxmin, &o_rxmax, &o_rymin, &o_rymax, &o_wxmin, &o_wxmax, &o_wymin, &o_wymax, &o_iwtrf); rxmin = rb_float_new((double)o_rxmin); rxmax = rb_float_new((double)o_rxmax); rymin = rb_float_new((double)o_rymin); rymax = rb_float_new((double)o_rymax); wxmin = rb_float_new((double)o_wxmin); wxmax = rb_float_new((double)o_wxmax); wymin = rb_float_new((double)o_wymin); wymax = rb_float_new((double)o_wymax); iwtrf = INT2NUM(o_iwtrf); return rb_ary_new3(9, rxmin, rxmax, rymin, rymax, wxmin, wxmax, wymin, wymax, iwtrf); } static VALUE dcl_stswrc(obj, wsxmn, wsxmx, wsymn, wsymx) VALUE obj, wsxmn, wsxmx, wsymn, wsymx; { real i_wsxmn; real i_wsxmx; real i_wsymn; real i_wsymx; if (TYPE(wsxmn) != T_FLOAT) { wsxmn = rb_funcall(wsxmn, rb_intern("to_f"), 0); } if (TYPE(wsxmx) != T_FLOAT) { wsxmx = rb_funcall(wsxmx, rb_intern("to_f"), 0); } if (TYPE(wsymn) != T_FLOAT) { wsymn = rb_funcall(wsymn, rb_intern("to_f"), 0); } if (TYPE(wsymx) != T_FLOAT) { wsymx = rb_funcall(wsymx, rb_intern("to_f"), 0); } i_wsxmn = (real)NUM2DBL(wsxmn); i_wsxmx = (real)NUM2DBL(wsxmx); i_wsymn = (real)NUM2DBL(wsymn); i_wsymx = (real)NUM2DBL(wsymx); stswrc_(&i_wsxmn, &i_wsxmx, &i_wsymn, &i_wsymx); return Qnil; } static VALUE dcl_stqwrc(obj) VALUE obj; { real o_wsxmn; real o_wsxmx; real o_wsymn; real o_wsymx; VALUE wsxmn; VALUE wsxmx; VALUE wsymn; VALUE wsymx; stqwrc_(&o_wsxmn, &o_wsxmx, &o_wsymn, &o_wsymx); wsxmn = rb_float_new((double)o_wsxmn); wsxmx = rb_float_new((double)o_wsxmx); wsymn = rb_float_new((double)o_wsymn); wsymx = rb_float_new((double)o_wsymx); return rb_ary_new3(4, wsxmn, wsxmx, wsymn, wsymx); } static VALUE dcl_stfpr3(obj, x, y, z) VALUE obj, x, y, z; { real i_x; real i_y; real i_z; real o_rx; real o_ry; VALUE rx; VALUE ry; if (TYPE(x) != T_FLOAT) { x = rb_funcall(x, rb_intern("to_f"), 0); } if (TYPE(y) != T_FLOAT) { y = rb_funcall(y, rb_intern("to_f"), 0); } if (TYPE(z) != T_FLOAT) { z = rb_funcall(z, rb_intern("to_f"), 0); } i_x = (real)NUM2DBL(x); i_y = (real)NUM2DBL(y); i_z = (real)NUM2DBL(z); stfpr3_(&i_x, &i_y, &i_z, &o_rx, &o_ry); rx = rb_float_new((double)o_rx); ry = rb_float_new((double)o_ry); return rb_ary_new3(2, rx, ry); } static VALUE dcl_stspr3(obj, xfc, yfc, zfc, theta, phi, psi, fac, zview, rxoff, ryoff) VALUE obj, xfc, yfc, zfc, theta, phi, psi, fac, zview, rxoff, ryoff; { real i_xfc; real i_yfc; real i_zfc; real i_theta; real i_phi; real i_psi; real i_fac; real i_zview; real i_rxoff; real i_ryoff; if (TYPE(xfc) != T_FLOAT) { xfc = rb_funcall(xfc, rb_intern("to_f"), 0); } if (TYPE(yfc) != T_FLOAT) { yfc = rb_funcall(yfc, rb_intern("to_f"), 0); } if (TYPE(zfc) != T_FLOAT) { zfc = rb_funcall(zfc, rb_intern("to_f"), 0); } if (TYPE(theta) != T_FLOAT) { theta = rb_funcall(theta, rb_intern("to_f"), 0); } if (TYPE(phi) != T_FLOAT) { phi = rb_funcall(phi, rb_intern("to_f"), 0); } if (TYPE(psi) != T_FLOAT) { psi = rb_funcall(psi, rb_intern("to_f"), 0); } if (TYPE(fac) != T_FLOAT) { fac = rb_funcall(fac, rb_intern("to_f"), 0); } if (TYPE(zview) != T_FLOAT) { zview = rb_funcall(zview, rb_intern("to_f"), 0); } if (TYPE(rxoff) != T_FLOAT) { rxoff = rb_funcall(rxoff, rb_intern("to_f"), 0); } if (TYPE(ryoff) != T_FLOAT) { ryoff = rb_funcall(ryoff, rb_intern("to_f"), 0); } i_xfc = (real)NUM2DBL(xfc); i_yfc = (real)NUM2DBL(yfc); i_zfc = (real)NUM2DBL(zfc); i_theta = (real)NUM2DBL(theta); i_phi = (real)NUM2DBL(phi); i_psi = (real)NUM2DBL(psi); i_fac = (real)NUM2DBL(fac); i_zview = (real)NUM2DBL(zview); i_rxoff = (real)NUM2DBL(rxoff); i_ryoff = (real)NUM2DBL(ryoff); stspr3_(&i_xfc, &i_yfc, &i_zfc, &i_theta, &i_phi, &i_psi, &i_fac, &i_zview, &i_rxoff, &i_ryoff); return Qnil; } static VALUE dcl_stfpr2(obj, x, y) VALUE obj, x, y; { real i_x; real i_y; real o_rx; real o_ry; VALUE rx; VALUE ry; if (TYPE(x) != T_FLOAT) { x = rb_funcall(x, rb_intern("to_f"), 0); } if (TYPE(y) != T_FLOAT) { y = rb_funcall(y, rb_intern("to_f"), 0); } i_x = (real)NUM2DBL(x); i_y = (real)NUM2DBL(y); stfpr2_(&i_x, &i_y, &o_rx, &o_ry); rx = rb_float_new((double)o_rx); ry = rb_float_new((double)o_ry); return rb_ary_new3(2, rx, ry); } static VALUE dcl_stipr2(obj, rx, ry) VALUE obj, rx, ry; { real i_rx; real i_ry; real o_x; real o_y; VALUE x; VALUE y; if (TYPE(rx) != T_FLOAT) { rx = rb_funcall(rx, rb_intern("to_f"), 0); } if (TYPE(ry) != T_FLOAT) { ry = rb_funcall(ry, rb_intern("to_f"), 0); } i_rx = (real)NUM2DBL(rx); i_ry = (real)NUM2DBL(ry); stipr2_(&i_rx, &i_ry, &o_x, &o_y); x = rb_float_new((double)o_x); y = rb_float_new((double)o_y); return rb_ary_new3(2, x, y); } static VALUE dcl_stspr2(obj, ix, iy, sect) VALUE obj, ix, iy, sect; { integer i_ix; integer i_iy; real i_sect; if ((TYPE(ix) != T_BIGNUM) || (TYPE(ix) != T_FIXNUM)) { ix = rb_funcall(ix, rb_intern("to_i"), 0); } if ((TYPE(iy) != T_BIGNUM) || (TYPE(iy) != T_FIXNUM)) { iy = rb_funcall(iy, rb_intern("to_i"), 0); } if (TYPE(sect) != T_FLOAT) { sect = rb_funcall(sect, rb_intern("to_f"), 0); } i_ix = NUM2INT(ix); i_iy = NUM2INT(iy); i_sect = (real)NUM2DBL(sect); stspr2_(&i_ix, &i_iy, &i_sect); return Qnil; } static VALUE dcl_stepr2(obj) VALUE obj; { stepr2_(); return Qnil; } static VALUE dcl_strpr2(obj) VALUE obj; { strpr2_(); return Qnil; } static VALUE dcl_stftr3(obj, ux, uy, uz) VALUE obj, ux, uy, uz; { real i_ux; real i_uy; real i_uz; real o_vx; real o_vy; real o_vz; VALUE vx; VALUE vy; VALUE vz; if (TYPE(ux) != T_FLOAT) { ux = rb_funcall(ux, rb_intern("to_f"), 0); } if (TYPE(uy) != T_FLOAT) { uy = rb_funcall(uy, rb_intern("to_f"), 0); } if (TYPE(uz) != T_FLOAT) { uz = rb_funcall(uz, rb_intern("to_f"), 0); } i_ux = (real)NUM2DBL(ux); i_uy = (real)NUM2DBL(uy); i_uz = (real)NUM2DBL(uz); stftr3_(&i_ux, &i_uy, &i_uz, &o_vx, &o_vy, &o_vz); vx = rb_float_new((double)o_vx); vy = rb_float_new((double)o_vy); vz = rb_float_new((double)o_vz); return rb_ary_new3(3, vx, vy, vz); } static VALUE dcl_ststr3(obj, itr, cxa, cya, cza, vxoff, vyoff, vzoff) VALUE obj, itr, cxa, cya, cza, vxoff, vyoff, vzoff; { integer i_itr; real i_cxa; real i_cya; real i_cza; real i_vxoff; real i_vyoff; real i_vzoff; if ((TYPE(itr) != T_BIGNUM) || (TYPE(itr) != T_FIXNUM)) { itr = rb_funcall(itr, rb_intern("to_i"), 0); } if (TYPE(cxa) != T_FLOAT) { cxa = rb_funcall(cxa, rb_intern("to_f"), 0); } if (TYPE(cya) != T_FLOAT) { cya = rb_funcall(cya, rb_intern("to_f"), 0); } if (TYPE(cza) != T_FLOAT) { cza = rb_funcall(cza, rb_intern("to_f"), 0); } if (TYPE(vxoff) != T_FLOAT) { vxoff = rb_funcall(vxoff, rb_intern("to_f"), 0); } if (TYPE(vyoff) != T_FLOAT) { vyoff = rb_funcall(vyoff, rb_intern("to_f"), 0); } if (TYPE(vzoff) != T_FLOAT) { vzoff = rb_funcall(vzoff, rb_intern("to_f"), 0); } i_itr = NUM2INT(itr); i_cxa = (real)NUM2DBL(cxa); i_cya = (real)NUM2DBL(cya); i_cza = (real)NUM2DBL(cza); i_vxoff = (real)NUM2DBL(vxoff); i_vyoff = (real)NUM2DBL(vyoff); i_vzoff = (real)NUM2DBL(vzoff); ststr3_(&i_itr, &i_cxa, &i_cya, &i_cza, &i_vxoff, &i_vyoff, &i_vzoff); return Qnil; } static VALUE dcl_stsrd3(obj, lxrd, lyrd, lzrd) VALUE obj, lxrd, lyrd, lzrd; { logical i_lxrd; logical i_lyrd; logical i_lzrd; i_lxrd = ((lxrd == Qnil)||(lxrd == Qfalse)) ? FALSE_ : TRUE_; i_lyrd = ((lyrd == Qnil)||(lyrd == Qfalse)) ? FALSE_ : TRUE_; i_lzrd = ((lzrd == Qnil)||(lzrd == Qfalse)) ? FALSE_ : TRUE_; stsrd3_(&i_lxrd, &i_lyrd, &i_lzrd); return Qnil; } static VALUE dcl_stslg3(obj, lxlg, lylg, lzlg) VALUE obj, lxlg, lylg, lzlg; { logical i_lxlg; logical i_lylg; logical i_lzlg; i_lxlg = ((lxlg == Qnil)||(lxlg == Qfalse)) ? FALSE_ : TRUE_; i_lylg = ((lylg == Qnil)||(lylg == Qfalse)) ? FALSE_ : TRUE_; i_lzlg = ((lzlg == Qnil)||(lzlg == Qfalse)) ? FALSE_ : TRUE_; stslg3_(&i_lxlg, &i_lylg, &i_lzlg); return Qnil; } void init_grph1_stpack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "stftrf", dcl_stftrf, 2); rb_define_module_function(mDCL, "stitrf", dcl_stitrf, 2); rb_define_module_function(mDCL, "stqtrf", dcl_stqtrf, 0); rb_define_module_function(mDCL, "ststrf", dcl_ststrf, 1); rb_define_module_function(mDCL, "stftrn", dcl_stftrn, 2); rb_define_module_function(mDCL, "stitrn", dcl_stitrn, 2); #if DCLVER >= 53 rb_define_module_function(mDCL, "ststri", dcl_ststri, 1); #endif #if DCLVER >= 53 rb_define_module_function(mDCL, "ststrp", dcl_ststrp, 4); #endif rb_define_module_function(mDCL, "ststrn", dcl_ststrn, 5); rb_define_module_function(mDCL, "stfrot", dcl_stfrot, 2); rb_define_module_function(mDCL, "stirot", dcl_stirot, 2); rb_define_module_function(mDCL, "stsrot", dcl_stsrot, 3); rb_define_module_function(mDCL, "stfrad", dcl_stfrad, 2); rb_define_module_function(mDCL, "stirad", dcl_stirad, 2); rb_define_module_function(mDCL, "stsrad", dcl_stsrad, 2); rb_define_module_function(mDCL, "stfusr", dcl_stfusr, 2); rb_define_module_function(mDCL, "stiusr", dcl_stiusr, 2); rb_define_module_function(mDCL, "stsusr", dcl_stsusr, 0); rb_define_module_function(mDCL, "stfwtr", dcl_stfwtr, 2); rb_define_module_function(mDCL, "stiwtr", dcl_stiwtr, 2); rb_define_module_function(mDCL, "stswtr", dcl_stswtr, 9); rb_define_module_function(mDCL, "stqwtr", dcl_stqwtr, 0); rb_define_module_function(mDCL, "stswrc", dcl_stswrc, 4); rb_define_module_function(mDCL, "stqwrc", dcl_stqwrc, 0); rb_define_module_function(mDCL, "stfpr3", dcl_stfpr3, 3); rb_define_module_function(mDCL, "stspr3", dcl_stspr3, 10); rb_define_module_function(mDCL, "stfpr2", dcl_stfpr2, 2); rb_define_module_function(mDCL, "stipr2", dcl_stipr2, 2); rb_define_module_function(mDCL, "stspr2", dcl_stspr2, 3); rb_define_module_function(mDCL, "stepr2", dcl_stepr2, 0); rb_define_module_function(mDCL, "strpr2", dcl_strpr2, 0); rb_define_module_function(mDCL, "stftr3", dcl_stftr3, 3); rb_define_module_function(mDCL, "ststr3", dcl_ststr3, 7); rb_define_module_function(mDCL, "stsrd3", dcl_stsrd3, 3); rb_define_module_function(mDCL, "stslg3", dcl_stslg3, 3); }