/*
* $Id: p_header,v 1.4 2000/11/27 01:57:01 keiko Exp $
*/
#include <stdio.h>
#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);
}
syntax highlighted by Code2HTML, v. 0.9.1