/*
 * $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 *);


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);

}

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);
    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);
}
