/*
* $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_usgrph(obj, n, x, y)
VALUE obj, n, x, y;
{
integer i_n;
real *i_x;
real *i_y;
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
if (TYPE(x) == T_FLOAT) {
x = rb_Array(x);
}
/* if ((TYPE(x) != T_ARRAY) &&
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if (TYPE(y) == T_FLOAT) {
y = rb_Array(y);
}
/* if ((TYPE(y) != T_ARRAY) &&
(rb_obj_is_kind_of(y, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
i_n = NUM2INT(n);
i_x = dcl_obj2crealary(x);
i_y = dcl_obj2crealary(y);
usgrph_(&i_n, i_x, i_y);
dcl_freecrealary(i_x);
dcl_freecrealary(i_y);
return Qnil;
}
static VALUE
dcl_ussttl(obj, cxttl, cxunit, cyttl, cyunit)
VALUE obj, cxttl, cxunit, cyttl, cyunit;
{
char *i_cxttl;
char *i_cxunit;
char *i_cyttl;
char *i_cyunit;
if (TYPE(cxttl) != T_STRING) {
cxttl = rb_funcall(cxttl, rb_intern("to_str"), 0);
}
if (TYPE(cxunit) != T_STRING) {
cxunit = rb_funcall(cxunit, rb_intern("to_str"), 0);
}
if (TYPE(cyttl) != T_STRING) {
cyttl = rb_funcall(cyttl, rb_intern("to_str"), 0);
}
if (TYPE(cyunit) != T_STRING) {
cyunit = rb_funcall(cyunit, rb_intern("to_str"), 0);
}
i_cxttl = STR2CSTR(cxttl);
i_cxunit = STR2CSTR(cxunit);
i_cyttl = STR2CSTR(cyttl);
i_cyunit = STR2CSTR(cyunit);
ussttl_(i_cxttl, i_cxunit, i_cyttl, i_cyunit, (ftnlen)strlen(i_cxttl), (ftnlen)strlen(i_cxunit), (ftnlen)strlen(i_cyttl), (ftnlen)strlen(i_cyunit));
return Qnil;
}
static VALUE
dcl_usspnt(obj, n, x, y)
VALUE obj, n, x, y;
{
integer i_n;
real *i_x;
real *i_y;
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
if (TYPE(x) == T_FLOAT) {
x = rb_Array(x);
}
/* if ((TYPE(x) != T_ARRAY) &&
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if (TYPE(y) == T_FLOAT) {
y = rb_Array(y);
}
/* if ((TYPE(y) != T_ARRAY) &&
(rb_obj_is_kind_of(y, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
i_n = NUM2INT(n);
i_x = dcl_obj2crealary(x);
i_y = dcl_obj2crealary(y);
usspnt_(&i_n, i_x, i_y);
dcl_freecrealary(i_x);
dcl_freecrealary(i_y);
return Qnil;
}
static VALUE
dcl_uspfit(obj)
VALUE obj;
{
uspfit_();
return Qnil;
}
static VALUE
dcl_usdaxs(obj)
VALUE obj;
{
usdaxs_();
return Qnil;
}
static VALUE
dcl_usinit(obj)
VALUE obj;
{
usinit_();
return Qnil;
}
static VALUE
dcl_uspqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
uspqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_uspqid(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_idx;
VALUE idx;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
uspqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_uspqcp(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
uspqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_uspqcl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
uspqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_uspqit(obj, idx)
VALUE obj, idx;
{
integer i_idx;
integer o_itp;
VALUE itp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
uspqit_(&i_idx, &o_itp);
itp = INT2NUM(o_itp);
return itp;
}
static VALUE
dcl_uspqvl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
integer o_ipara;
VALUE ipara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
uspqvl_(&i_idx, &o_ipara);
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_uspsvl(obj, idx, ipara)
VALUE obj, idx, ipara;
{
integer i_idx;
integer i_ipara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
i_ipara = NUM2INT(ipara);
uspsvl_(&i_idx, &i_ipara);
return Qnil;
}
static VALUE
dcl_uspqin(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_in;
VALUE in;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
uspqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_uscget(obj, cp)
VALUE obj, cp;
{
char *i_cp;
char *o_cpara;
VALUE cpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
o_cpara= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cpara, '\0', DFLT_SIZE+1);
uscget_(i_cp, o_cpara, (ftnlen)strlen(i_cp), (ftnlen)DFLT_SIZE);
cpara = rb_str_new2(o_cpara);
return cpara;
}
static VALUE
dcl_uscset(obj, cp, cpara)
VALUE obj, cp, cpara;
{
char *i_cp;
char *i_cpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
if (TYPE(cpara) != T_STRING) {
cpara = rb_funcall(cpara, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
i_cpara = STR2CSTR(cpara);
uscset_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara));
return Qnil;
}
static VALUE
dcl_uscstx(obj, cp, cpara)
VALUE obj, cp, cpara;
{
char *i_cp;
char *i_cpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
if (TYPE(cpara) != T_STRING) {
cpara = rb_funcall(cpara, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
i_cpara = STR2CSTR(cpara);
uscstx_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara));
return Qnil;
}
static VALUE
dcl_uscqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
uscqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_uscqid(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_idx;
VALUE idx;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
uscqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_uscqcp(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
uscqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_uscqcl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
uscqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_uscqvl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cval;
VALUE cval;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cval= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cval, '\0', DFLT_SIZE+1);
uscqvl_(&i_idx, o_cval, (ftnlen)DFLT_SIZE);
cval = rb_str_new2(o_cval);
return cval;
}
static VALUE
dcl_uscsvl(obj, idx, cval)
VALUE obj, idx, cval;
{
integer i_idx;
char *i_cval;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
if (TYPE(cval) != T_STRING) {
cval = rb_funcall(cval, rb_intern("to_str"), 0);
}
i_idx = NUM2INT(idx);
i_cval = STR2CSTR(cval);
uscsvl_(&i_idx, i_cval, (ftnlen)strlen(i_cval));
return Qnil;
}
static VALUE
dcl_uscqin(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_in;
VALUE in;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
uscqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_usurdl(obj, umin, umax, vmin, vmax)
VALUE obj, umin, umax, vmin, vmax;
{
real io_umin;
real io_umax;
real i_vmin;
real i_vmax;
if (TYPE(umin) != T_FLOAT) {
umin = rb_funcall(umin, rb_intern("to_f"), 0);
}
if (TYPE(umax) != T_FLOAT) {
umax = rb_funcall(umax, rb_intern("to_f"), 0);
}
if (TYPE(vmin) != T_FLOAT) {
vmin = rb_funcall(vmin, rb_intern("to_f"), 0);
}
if (TYPE(vmax) != T_FLOAT) {
vmax = rb_funcall(vmax, rb_intern("to_f"), 0);
}
io_umin = (real)NUM2DBL(umin);
io_umax = (real)NUM2DBL(umax);
i_vmin = (real)NUM2DBL(vmin);
i_vmax = (real)NUM2DBL(vmax);
usurdl_(&io_umin, &io_umax, &i_vmin, &i_vmax);
umin = rb_float_new((double)io_umin);
umax = rb_float_new((double)io_umax);
return rb_ary_new3(2, umin, umax);
}
static VALUE
dcl_usxaxs(obj, cside)
VALUE obj, cside;
{
char *i_cside;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
i_cside = STR2CSTR(cside);
usxaxs_(i_cside, (ftnlen)strlen(i_cside));
return Qnil;
}
static VALUE
dcl_usyaxs(obj, cside)
VALUE obj, cside;
{
char *i_cside;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
i_cside = STR2CSTR(cside);
usyaxs_(i_cside, (ftnlen)strlen(i_cside));
return Qnil;
}
static VALUE
dcl_ususcu(obj, caxis, umin, umax, vmin, vmax, mode)
VALUE obj, caxis, umin, umax, vmin, vmax, mode;
{
char *i_caxis;
real i_umin;
real i_umax;
real i_vmin;
real i_vmax;
integer i_mode;
if (TYPE(caxis) != T_STRING) {
caxis = rb_funcall(caxis, rb_intern("to_str"), 0);
}
if (TYPE(umin) != T_FLOAT) {
umin = rb_funcall(umin, rb_intern("to_f"), 0);
}
if (TYPE(umax) != T_FLOAT) {
umax = rb_funcall(umax, rb_intern("to_f"), 0);
}
if (TYPE(vmin) != T_FLOAT) {
vmin = rb_funcall(vmin, rb_intern("to_f"), 0);
}
if (TYPE(vmax) != T_FLOAT) {
vmax = rb_funcall(vmax, rb_intern("to_f"), 0);
}
if ((TYPE(mode) != T_BIGNUM) || (TYPE(mode) != T_FIXNUM)) {
mode = rb_funcall(mode, rb_intern("to_i"), 0);
}
i_caxis = STR2CSTR(caxis);
i_umin = (real)NUM2DBL(umin);
i_umax = (real)NUM2DBL(umax);
i_vmin = (real)NUM2DBL(vmin);
i_vmax = (real)NUM2DBL(vmax);
i_mode = NUM2INT(mode);
ususcu_(i_caxis, &i_umin, &i_umax, &i_vmin, &i_vmax, &i_mode, (ftnlen)strlen(i_caxis));
return Qnil;
}
static VALUE
dcl_ususcl(obj, caxis, umin, umax, vmin, vmax)
VALUE obj, caxis, umin, umax, vmin, vmax;
{
char *i_caxis;
real i_umin;
real i_umax;
real i_vmin;
real i_vmax;
if (TYPE(caxis) != T_STRING) {
caxis = rb_funcall(caxis, rb_intern("to_str"), 0);
}
if (TYPE(umin) != T_FLOAT) {
umin = rb_funcall(umin, rb_intern("to_f"), 0);
}
if (TYPE(umax) != T_FLOAT) {
umax = rb_funcall(umax, rb_intern("to_f"), 0);
}
if (TYPE(vmin) != T_FLOAT) {
vmin = rb_funcall(vmin, rb_intern("to_f"), 0);
}
if (TYPE(vmax) != T_FLOAT) {
vmax = rb_funcall(vmax, rb_intern("to_f"), 0);
}
i_caxis = STR2CSTR(caxis);
i_umin = (real)NUM2DBL(umin);
i_umax = (real)NUM2DBL(umax);
i_vmin = (real)NUM2DBL(vmin);
i_vmax = (real)NUM2DBL(vmax);
ususcl_(i_caxis, &i_umin, &i_umax, &i_vmin, &i_vmax, (ftnlen)strlen(i_caxis));
return Qnil;
}
static VALUE
dcl_usxaxu(obj, cxs)
VALUE obj, cxs;
{
char *i_cxs;
if (TYPE(cxs) != T_STRING) {
cxs = rb_funcall(cxs, rb_intern("to_str"), 0);
}
i_cxs = STR2CSTR(cxs);
usxaxu_(i_cxs, (ftnlen)strlen(i_cxs));
return Qnil;
}
static VALUE
dcl_usxaxl(obj, cxs)
VALUE obj, cxs;
{
char *i_cxs;
if (TYPE(cxs) != T_STRING) {
cxs = rb_funcall(cxs, rb_intern("to_str"), 0);
}
i_cxs = STR2CSTR(cxs);
usxaxl_(i_cxs, (ftnlen)strlen(i_cxs));
return Qnil;
}
static VALUE
dcl_usyaxu(obj, cys)
VALUE obj, cys;
{
char *i_cys;
if (TYPE(cys) != T_STRING) {
cys = rb_funcall(cys, rb_intern("to_str"), 0);
}
i_cys = STR2CSTR(cys);
usyaxu_(i_cys, (ftnlen)strlen(i_cys));
return Qnil;
}
static VALUE
dcl_usyaxl(obj, cys)
VALUE obj, cys;
{
char *i_cys;
if (TYPE(cys) != T_STRING) {
cys = rb_funcall(cys, rb_intern("to_str"), 0);
}
i_cys = STR2CSTR(cys);
usyaxl_(i_cys, (ftnlen)strlen(i_cys));
return Qnil;
}
static VALUE
dcl_usxsub(obj, cxa, cya, clabel, rlbl)
VALUE obj, cxa, cya, clabel, rlbl;
{
char *i_cxa;
char *i_cya;
char *i_clabel;
real i_rlbl;
if (TYPE(cxa) != T_STRING) {
cxa = rb_funcall(cxa, rb_intern("to_str"), 0);
}
if (TYPE(cya) != T_STRING) {
cya = rb_funcall(cya, rb_intern("to_str"), 0);
}
if (TYPE(clabel) != T_STRING) {
clabel = rb_funcall(clabel, rb_intern("to_str"), 0);
}
if (TYPE(rlbl) != T_FLOAT) {
rlbl = rb_funcall(rlbl, rb_intern("to_f"), 0);
}
i_cxa = STR2CSTR(cxa);
i_cya = STR2CSTR(cya);
i_clabel = STR2CSTR(clabel);
i_rlbl = (real)NUM2DBL(rlbl);
usxsub_(i_cxa, i_cya, i_clabel, &i_rlbl, (ftnlen)strlen(i_cxa), (ftnlen)strlen(i_cya), (ftnlen)strlen(i_clabel));
return Qnil;
}
static VALUE
dcl_usysub(obj, cya, cxa, clabel, rlbl)
VALUE obj, cya, cxa, clabel, rlbl;
{
char *i_cya;
char *i_cxa;
char *i_clabel;
real i_rlbl;
if (TYPE(cya) != T_STRING) {
cya = rb_funcall(cya, rb_intern("to_str"), 0);
}
if (TYPE(cxa) != T_STRING) {
cxa = rb_funcall(cxa, rb_intern("to_str"), 0);
}
if (TYPE(clabel) != T_STRING) {
clabel = rb_funcall(clabel, rb_intern("to_str"), 0);
}
if (TYPE(rlbl) != T_FLOAT) {
rlbl = rb_funcall(rlbl, rb_intern("to_f"), 0);
}
i_cya = STR2CSTR(cya);
i_cxa = STR2CSTR(cxa);
i_clabel = STR2CSTR(clabel);
i_rlbl = (real)NUM2DBL(rlbl);
usysub_(i_cya, i_cxa, i_clabel, &i_rlbl, (ftnlen)strlen(i_cya), (ftnlen)strlen(i_cxa), (ftnlen)strlen(i_clabel));
return Qnil;
}
static VALUE
dcl_csblbl(obj, ufac, uoff, cunit)
VALUE obj, ufac, uoff, cunit;
{
real i_ufac;
real i_uoff;
char *i_cunit;
char *o_rtn_val;
VALUE rtn_val;
if (TYPE(ufac) != T_FLOAT) {
ufac = rb_funcall(ufac, rb_intern("to_f"), 0);
}
if (TYPE(uoff) != T_FLOAT) {
uoff = rb_funcall(uoff, rb_intern("to_f"), 0);
}
if (TYPE(cunit) != T_STRING) {
cunit = rb_funcall(cunit, rb_intern("to_str"), 0);
}
i_ufac = (real)NUM2DBL(ufac);
i_uoff = (real)NUM2DBL(uoff);
i_cunit = STR2CSTR(cunit);
o_rtn_val= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_rtn_val, '\0', DFLT_SIZE+1);
csblbl_(o_rtn_val, (ftnlen)DFLT_SIZE, &i_ufac, &i_uoff, i_cunit, (ftnlen)strlen(i_cunit));
rtn_val = rb_str_new2(o_rtn_val);
return rtn_val;
}
static VALUE
dcl_uschvl(obj, x)
VALUE obj, x;
{
real i_x;
char *o_chx;
VALUE chx;
if (TYPE(x) != T_FLOAT) {
x = rb_funcall(x, rb_intern("to_f"), 0);
}
i_x = (real)NUM2DBL(x);
o_chx= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_chx, '\0', DFLT_SIZE+1);
uschvl_(&i_x, o_chx, (ftnlen)DFLT_SIZE);
chx = rb_str_new2(o_chx);
return chx;
}
static VALUE
dcl_usxoff(obj, cxs)
VALUE obj, cxs;
{
char *i_cxs;
if (TYPE(cxs) != T_STRING) {
cxs = rb_funcall(cxs, rb_intern("to_str"), 0);
}
i_cxs = STR2CSTR(cxs);
usxoff_(i_cxs, (ftnlen)strlen(i_cxs));
return Qnil;
}
static VALUE
dcl_usyoff(obj, cys)
VALUE obj, cys;
{
char *i_cys;
if (TYPE(cys) != T_STRING) {
cys = rb_funcall(cys, rb_intern("to_str"), 0);
}
i_cys = STR2CSTR(cys);
usyoff_(i_cys, (ftnlen)strlen(i_cys));
return Qnil;
}
static VALUE
dcl_uszdgt(obj, umin, umax, dul, maxdgt, uoff, ufact)
VALUE obj, umin, umax, dul, maxdgt, uoff, ufact;
{
real i_umin;
real i_umax;
real i_dul;
integer i_maxdgt;
real io_uoff;
real io_ufact;
integer o_ndgt;
integer o_ldgt;
VALUE ndgt;
VALUE ldgt;
if (TYPE(umin) != T_FLOAT) {
umin = rb_funcall(umin, rb_intern("to_f"), 0);
}
if (TYPE(umax) != T_FLOAT) {
umax = rb_funcall(umax, rb_intern("to_f"), 0);
}
if (TYPE(dul) != T_FLOAT) {
dul = rb_funcall(dul, rb_intern("to_f"), 0);
}
if ((TYPE(maxdgt) != T_BIGNUM) || (TYPE(maxdgt) != T_FIXNUM)) {
maxdgt = rb_funcall(maxdgt, rb_intern("to_i"), 0);
}
if (TYPE(uoff) != T_FLOAT) {
uoff = rb_funcall(uoff, rb_intern("to_f"), 0);
}
if (TYPE(ufact) != T_FLOAT) {
ufact = rb_funcall(ufact, rb_intern("to_f"), 0);
}
i_umin = (real)NUM2DBL(umin);
i_umax = (real)NUM2DBL(umax);
i_dul = (real)NUM2DBL(dul);
i_maxdgt = NUM2INT(maxdgt);
io_uoff = (real)NUM2DBL(uoff);
io_ufact = (real)NUM2DBL(ufact);
uszdgt_(&i_umin, &i_umax, &i_dul, &i_maxdgt, &io_uoff, &io_ufact, &o_ndgt, &o_ldgt);
uoff = rb_float_new((double)io_uoff);
ufact = rb_float_new((double)io_ufact);
ndgt = INT2NUM(o_ndgt);
ldgt = INT2NUM(o_ldgt);
return rb_ary_new3(4, uoff, ufact, ndgt, ldgt);
}
static VALUE
dcl_uswapz(obj, x1, x2, n)
VALUE obj, x1, x2, n;
{
real *io_x1;
real *io_x2;
integer i_n;
if (TYPE(x1) == T_FLOAT) {
x1 = rb_Array(x1);
}
/* if ((TYPE(x1) != T_ARRAY) &&
(rb_obj_is_kind_of(x1, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if (TYPE(x2) == T_FLOAT) {
x2 = rb_Array(x2);
}
/* if ((TYPE(x2) != T_ARRAY) &&
(rb_obj_is_kind_of(x2, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
i_n = NUM2INT(n);
io_x1 = dcl_obj2crealary(x1);
io_x2 = dcl_obj2crealary(x2);
uswapz_(io_x1, io_x2, &i_n);
{int array_shape[1] = {i_n};
x1 = dcl_crealary2obj(io_x1, (i_n), 1, array_shape);
}
{int array_shape[1] = {i_n};
x2 = dcl_crealary2obj(io_x2, (i_n), 1, array_shape);
}
dcl_freecrealary(io_x1);
dcl_freecrealary(io_x2);
return rb_ary_new3(2, x1, x2);
}
static VALUE
dcl_usurdt(obj, umin, umax, vmin, vmax)
VALUE obj, umin, umax, vmin, vmax;
{
real io_umin;
real io_umax;
real i_vmin;
real i_vmax;
real o_dut;
VALUE dut;
if (TYPE(umin) != T_FLOAT) {
umin = rb_funcall(umin, rb_intern("to_f"), 0);
}
if (TYPE(umax) != T_FLOAT) {
umax = rb_funcall(umax, rb_intern("to_f"), 0);
}
if (TYPE(vmin) != T_FLOAT) {
vmin = rb_funcall(vmin, rb_intern("to_f"), 0);
}
if (TYPE(vmax) != T_FLOAT) {
vmax = rb_funcall(vmax, rb_intern("to_f"), 0);
}
io_umin = (real)NUM2DBL(umin);
io_umax = (real)NUM2DBL(umax);
i_vmin = (real)NUM2DBL(vmin);
i_vmax = (real)NUM2DBL(vmax);
usurdt_(&io_umin, &io_umax, &i_vmin, &i_vmax, &o_dut);
umin = rb_float_new((double)io_umin);
umax = rb_float_new((double)io_umax);
dut = rb_float_new((double)o_dut);
return rb_ary_new3(3, umin, umax, dut);
}
static VALUE
dcl_usaxcl(obj, cside, jd0, ctype, nd)
VALUE obj, cside, jd0, ctype, nd;
{
char *i_cside;
integer i_jd0;
char *i_ctype;
integer i_nd;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if ((TYPE(jd0) != T_BIGNUM) || (TYPE(jd0) != T_FIXNUM)) {
jd0 = rb_funcall(jd0, rb_intern("to_i"), 0);
}
if (TYPE(ctype) != T_STRING) {
ctype = rb_funcall(ctype, rb_intern("to_str"), 0);
}
if ((TYPE(nd) != T_BIGNUM) || (TYPE(nd) != T_FIXNUM)) {
nd = rb_funcall(nd, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_jd0 = NUM2INT(jd0);
i_ctype = STR2CSTR(ctype);
i_nd = NUM2INT(nd);
usaxcl_(i_cside, &i_jd0, i_ctype, &i_nd, (ftnlen)strlen(i_cside), (ftnlen)strlen(i_ctype));
return Qnil;
}
static VALUE
dcl_usaxdv(obj, cside, dtick, dlbl)
VALUE obj, cside, dtick, dlbl;
{
char *i_cside;
real i_dtick;
real i_dlbl;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if (TYPE(dtick) != T_FLOAT) {
dtick = rb_funcall(dtick, rb_intern("to_f"), 0);
}
if (TYPE(dlbl) != T_FLOAT) {
dlbl = rb_funcall(dlbl, rb_intern("to_f"), 0);
}
i_cside = STR2CSTR(cside);
i_dtick = (real)NUM2DBL(dtick);
i_dlbl = (real)NUM2DBL(dlbl);
usaxdv_(i_cside, &i_dtick, &i_dlbl, (ftnlen)strlen(i_cside));
return Qnil;
}
static VALUE
dcl_usaxlb(obj, cside, dtick, n1, dlabel, ch, nc, n2)
VALUE obj, cside, dtick, n1, dlabel, ch, nc, n2;
{
char *i_cside;
real *i_dtick;
integer i_n1;
real *i_dlabel;
char *i_ch;
integer i_nc;
integer i_n2;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if (TYPE(dtick) == T_FLOAT) {
dtick = rb_Array(dtick);
}
/* if ((TYPE(dtick) != T_ARRAY) &&
(rb_obj_is_kind_of(dtick, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(n1) != T_BIGNUM) || (TYPE(n1) != T_FIXNUM)) {
n1 = rb_funcall(n1, rb_intern("to_i"), 0);
}
if (TYPE(dlabel) == T_FLOAT) {
dlabel = rb_Array(dlabel);
}
/* if ((TYPE(dlabel) != T_ARRAY) &&
(rb_obj_is_kind_of(dlabel, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if (TYPE(ch) == T_STRING) {
ch = rb_Array(ch);
}
if (TYPE(ch) != T_ARRAY) {
rb_raise(rb_eTypeError, "invalid type");
}
if ((TYPE(nc) != T_BIGNUM) || (TYPE(nc) != T_FIXNUM)) {
nc = rb_funcall(nc, rb_intern("to_i"), 0);
}
if ((TYPE(n2) != T_BIGNUM) || (TYPE(n2) != T_FIXNUM)) {
n2 = rb_funcall(n2, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_n1 = NUM2INT(n1);
i_nc = NUM2INT(nc);
i_n2 = NUM2INT(n2);
i_dtick = dcl_obj2crealary(dtick);
i_dlabel = dcl_obj2crealary(dlabel);
i_ch = dcl_obj2ccharary(ch, (i_n2*DFLT_SIZE), DFLT_SIZE);
usaxlb_(i_cside, i_dtick, &i_n1, i_dlabel, i_ch, &i_nc, &i_n2, (ftnlen)strlen(i_cside), (ftnlen)DFLT_SIZE);
dcl_freecrealary(i_dtick);
dcl_freecrealary(i_dlabel);
dcl_freeccharary(i_ch);
return Qnil;
}
static VALUE
dcl_usaxlg(obj, cside, nlbl, nticks)
VALUE obj, cside, nlbl, nticks;
{
char *i_cside;
integer i_nlbl;
integer i_nticks;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if ((TYPE(nlbl) != T_BIGNUM) || (TYPE(nlbl) != T_FIXNUM)) {
nlbl = rb_funcall(nlbl, rb_intern("to_i"), 0);
}
if ((TYPE(nticks) != T_BIGNUM) || (TYPE(nticks) != T_FIXNUM)) {
nticks = rb_funcall(nticks, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_nlbl = NUM2INT(nlbl);
i_nticks = NUM2INT(nticks);
usaxlg_(i_cside, &i_nlbl, &i_nticks, (ftnlen)strlen(i_cside));
return Qnil;
}
static VALUE
dcl_usaxnm(obj, cside, dtick, n1, dlabel, n2)
VALUE obj, cside, dtick, n1, dlabel, n2;
{
char *i_cside;
real *i_dtick;
integer i_n1;
real *i_dlabel;
integer i_n2;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if (TYPE(dtick) == T_FLOAT) {
dtick = rb_Array(dtick);
}
/* if ((TYPE(dtick) != T_ARRAY) &&
(rb_obj_is_kind_of(dtick, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(n1) != T_BIGNUM) || (TYPE(n1) != T_FIXNUM)) {
n1 = rb_funcall(n1, rb_intern("to_i"), 0);
}
if (TYPE(dlabel) == T_FLOAT) {
dlabel = rb_Array(dlabel);
}
/* if ((TYPE(dlabel) != T_ARRAY) &&
(rb_obj_is_kind_of(dlabel, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(n2) != T_BIGNUM) || (TYPE(n2) != T_FIXNUM)) {
n2 = rb_funcall(n2, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_n1 = NUM2INT(n1);
i_n2 = NUM2INT(n2);
i_dtick = dcl_obj2crealary(dtick);
i_dlabel = dcl_obj2crealary(dlabel);
usaxnm_(i_cside, i_dtick, &i_n1, i_dlabel, &i_n2, (ftnlen)strlen(i_cside));
dcl_freecrealary(i_dtick);
dcl_freecrealary(i_dlabel);
return Qnil;
}
static VALUE
dcl_usaxsc(obj, cside)
VALUE obj, cside;
{
char *i_cside;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
i_cside = STR2CSTR(cside);
usaxsc_(i_cside, (ftnlen)strlen(i_cside));
return Qnil;
}
static VALUE
dcl_usiget(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_ipara;
VALUE ipara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
usiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp));
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_usiset(obj, cp, ipara)
VALUE obj, cp, ipara;
{
char *i_cp;
integer i_ipara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
}
i_cp = STR2CSTR(cp);
i_ipara = NUM2INT(ipara);
usiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_usistx(obj, cp, ipara)
VALUE obj, cp, ipara;
{
char *i_cp;
integer i_ipara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
}
i_cp = STR2CSTR(cp);
i_ipara = NUM2INT(ipara);
usistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_usiqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
usiqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_usiqid(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_idx;
VALUE idx;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
usiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_usiqcp(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
usiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_usiqcl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
usiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_usiqvl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
integer o_ipara;
VALUE ipara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
usiqvl_(&i_idx, &o_ipara);
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_usisvl(obj, idx, ipara)
VALUE obj, idx, ipara;
{
integer i_idx;
integer i_ipara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
i_ipara = NUM2INT(ipara);
usisvl_(&i_idx, &i_ipara);
return Qnil;
}
static VALUE
dcl_usiqin(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_in;
VALUE in;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
usiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_uslget(obj, cp)
VALUE obj, cp;
{
char *i_cp;
logical o_lpara;
VALUE lpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
uslget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp));
lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
return lpara;
}
static VALUE
dcl_uslset(obj, cp, lpara)
VALUE obj, cp, lpara;
{
char *i_cp;
logical i_lpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;
uslset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_uslstx(obj, cp, lpara)
VALUE obj, cp, lpara;
{
char *i_cp;
logical i_lpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;
uslstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_uslqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
uslqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_uslqid(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_idx;
VALUE idx;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
uslqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_uslqcp(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
uslqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_uslqcl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
uslqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_uslqvl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
logical o_lpara;
VALUE lpara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
uslqvl_(&i_idx, &o_lpara);
lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
return lpara;
}
static VALUE
dcl_uslsvl(obj, idx, lpara)
VALUE obj, idx, lpara;
{
integer i_idx;
logical i_lpara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;
uslsvl_(&i_idx, &i_lpara);
return Qnil;
}
static VALUE
dcl_uslqin(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_in;
VALUE in;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
uslqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_uspaxs(obj, cside, islct)
VALUE obj, cside, islct;
{
char *i_cside;
integer i_islct;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) {
islct = rb_funcall(islct, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_islct = NUM2INT(islct);
uspaxs_(i_cside, &i_islct, (ftnlen)strlen(i_cside));
return Qnil;
}
static VALUE
dcl_usplbl(obj, cside, islct, pos, ch, nc, n)
VALUE obj, cside, islct, pos, ch, nc, n;
{
char *i_cside;
integer i_islct;
real *i_pos;
char *i_ch;
integer i_nc;
integer i_n;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) {
islct = rb_funcall(islct, rb_intern("to_i"), 0);
}
if (TYPE(pos) == T_FLOAT) {
pos = rb_Array(pos);
}
/* if ((TYPE(pos) != T_ARRAY) &&
(rb_obj_is_kind_of(pos, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if (TYPE(ch) == T_STRING) {
ch = rb_Array(ch);
}
if (TYPE(ch) != T_ARRAY) {
rb_raise(rb_eTypeError, "invalid type");
}
if ((TYPE(nc) != T_BIGNUM) || (TYPE(nc) != T_FIXNUM)) {
nc = rb_funcall(nc, rb_intern("to_i"), 0);
}
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_islct = NUM2INT(islct);
i_nc = NUM2INT(nc);
i_n = NUM2INT(n);
i_pos = dcl_obj2crealary(pos);
i_ch = dcl_obj2ccharary(ch, (i_n*DFLT_SIZE), DFLT_SIZE);
usplbl_(i_cside, &i_islct, i_pos, i_ch, &i_nc, &i_n, (ftnlen)strlen(i_cside), (ftnlen)DFLT_SIZE);
dcl_freecrealary(i_pos);
dcl_freeccharary(i_ch);
return Qnil;
}
static VALUE
dcl_uspnum(obj, cside, islct, pos, n)
VALUE obj, cside, islct, pos, n;
{
char *i_cside;
integer i_islct;
real *i_pos;
integer i_n;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) {
islct = rb_funcall(islct, rb_intern("to_i"), 0);
}
if (TYPE(pos) == T_FLOAT) {
pos = rb_Array(pos);
}
/* if ((TYPE(pos) != T_ARRAY) &&
(rb_obj_is_kind_of(pos, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_islct = NUM2INT(islct);
i_n = NUM2INT(n);
i_pos = dcl_obj2crealary(pos);
uspnum_(i_cside, &i_islct, i_pos, &i_n, (ftnlen)strlen(i_cside));
dcl_freecrealary(i_pos);
return Qnil;
}
static VALUE
dcl_usptmk(obj, cside, islct, pos, n)
VALUE obj, cside, islct, pos, n;
{
char *i_cside;
integer i_islct;
real *i_pos;
integer i_n;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) {
islct = rb_funcall(islct, rb_intern("to_i"), 0);
}
if (TYPE(pos) == T_FLOAT) {
pos = rb_Array(pos);
}
/* if ((TYPE(pos) != T_ARRAY) &&
(rb_obj_is_kind_of(pos, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
i_cside = STR2CSTR(cside);
i_islct = NUM2INT(islct);
i_n = NUM2INT(n);
i_pos = dcl_obj2crealary(pos);
usptmk_(i_cside, &i_islct, i_pos, &i_n, (ftnlen)strlen(i_cside));
dcl_freecrealary(i_pos);
return Qnil;
}
static VALUE
dcl_uspttl(obj, cside, islct, cttl, pos)
VALUE obj, cside, islct, cttl, pos;
{
char *i_cside;
integer i_islct;
char *i_cttl;
real i_pos;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
if ((TYPE(islct) != T_BIGNUM) || (TYPE(islct) != T_FIXNUM)) {
islct = rb_funcall(islct, rb_intern("to_i"), 0);
}
if (TYPE(cttl) != T_STRING) {
cttl = rb_funcall(cttl, rb_intern("to_str"), 0);
}
if (TYPE(pos) != T_FLOAT) {
pos = rb_funcall(pos, rb_intern("to_f"), 0);
}
i_cside = STR2CSTR(cside);
i_islct = NUM2INT(islct);
i_cttl = STR2CSTR(cttl);
i_pos = (real)NUM2DBL(pos);
uspttl_(i_cside, &i_islct, i_cttl, &i_pos, (ftnlen)strlen(i_cside), (ftnlen)strlen(i_cttl));
return Qnil;
}
static VALUE
dcl_usrget(obj, cp)
VALUE obj, cp;
{
char *i_cp;
real o_rpara;
VALUE rpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
usrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp));
rpara = rb_float_new((double)o_rpara);
return rpara;
}
static VALUE
dcl_usrset(obj, cp, rpara)
VALUE obj, cp, rpara;
{
char *i_cp;
real i_rpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
if (TYPE(rpara) != T_FLOAT) {
rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
}
i_cp = STR2CSTR(cp);
i_rpara = (real)NUM2DBL(rpara);
usrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_usrstx(obj, cp, rpara)
VALUE obj, cp, rpara;
{
char *i_cp;
real i_rpara;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
if (TYPE(rpara) != T_FLOAT) {
rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
}
i_cp = STR2CSTR(cp);
i_rpara = (real)NUM2DBL(rpara);
usrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_usrqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
usrqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_usrqid(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_idx;
VALUE idx;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
usrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_usrqcp(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
usrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_usrqcl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
char *o_cp;
VALUE cp;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cp, '\0', DFLT_SIZE+1);
usrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_usrqvl(obj, idx)
VALUE obj, idx;
{
integer i_idx;
real o_rpara;
VALUE rpara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
i_idx = NUM2INT(idx);
usrqvl_(&i_idx, &o_rpara);
rpara = rb_float_new((double)o_rpara);
return rpara;
}
static VALUE
dcl_usrsvl(obj, idx, rpara)
VALUE obj, idx, rpara;
{
integer i_idx;
real i_rpara;
if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
idx = rb_funcall(idx, rb_intern("to_i"), 0);
}
if (TYPE(rpara) != T_FLOAT) {
rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
}
i_idx = NUM2INT(idx);
i_rpara = (real)NUM2DBL(rpara);
usrsvl_(&i_idx, &i_rpara);
return Qnil;
}
static VALUE
dcl_usrqin(obj, cp)
VALUE obj, cp;
{
char *i_cp;
integer o_in;
VALUE in;
if (TYPE(cp) != T_STRING) {
cp = rb_funcall(cp, rb_intern("to_str"), 0);
}
i_cp = STR2CSTR(cp);
usrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_ussaxs(obj, cside)
VALUE obj, cside;
{
char *i_cside;
if (TYPE(cside) != T_STRING) {
cside = rb_funcall(cside, rb_intern("to_str"), 0);
}
i_cside = STR2CSTR(cside);
ussaxs_(i_cside, (ftnlen)strlen(i_cside));
return Qnil;
}
static VALUE
dcl_usxinz(obj, csa)
VALUE obj, csa;
{
char *i_csa;
real o_faca;
real o_offa;
VALUE faca;
VALUE offa;
if (TYPE(csa) != T_STRING) {
csa = rb_funcall(csa, rb_intern("to_str"), 0);
}
i_csa = STR2CSTR(csa);
usxinz_(i_csa, &o_faca, &o_offa, (ftnlen)strlen(i_csa));
faca = rb_float_new((double)o_faca);
offa = rb_float_new((double)o_offa);
return rb_ary_new3(2, faca, offa);
}
static VALUE
dcl_usxtlz(obj)
VALUE obj;
{
usxtlz_();
return Qnil;
}
static VALUE
dcl_usyinz(obj, csa)
VALUE obj, csa;
{
char *i_csa;
real o_faca;
real o_offa;
VALUE faca;
VALUE offa;
if (TYPE(csa) != T_STRING) {
csa = rb_funcall(csa, rb_intern("to_str"), 0);
}
i_csa = STR2CSTR(csa);
usyinz_(i_csa, &o_faca, &o_offa, (ftnlen)strlen(i_csa));
faca = rb_float_new((double)o_faca);
offa = rb_float_new((double)o_offa);
return rb_ary_new3(2, faca, offa);
}
static VALUE
dcl_usytlz(obj)
VALUE obj;
{
usytlz_();
return Qnil;
}
void
init_grph2_uspack(mDCL)
VALUE mDCL;
{
rb_define_module_function(mDCL, "usgrph", dcl_usgrph, 3);
rb_define_module_function(mDCL, "ussttl", dcl_ussttl, 4);
rb_define_module_function(mDCL, "usspnt", dcl_usspnt, 3);
rb_define_module_function(mDCL, "uspfit", dcl_uspfit, 0);
rb_define_module_function(mDCL, "usdaxs", dcl_usdaxs, 0);
rb_define_module_function(mDCL, "usinit", dcl_usinit, 0);
rb_define_module_function(mDCL, "uspqnp", dcl_uspqnp, 0);
rb_define_module_function(mDCL, "uspqid", dcl_uspqid, 1);
rb_define_module_function(mDCL, "uspqcp", dcl_uspqcp, 1);
rb_define_module_function(mDCL, "uspqcl", dcl_uspqcl, 1);
rb_define_module_function(mDCL, "uspqit", dcl_uspqit, 1);
rb_define_module_function(mDCL, "uspqvl", dcl_uspqvl, 1);
rb_define_module_function(mDCL, "uspsvl", dcl_uspsvl, 2);
rb_define_module_function(mDCL, "uspqin", dcl_uspqin, 1);
rb_define_module_function(mDCL, "uscget", dcl_uscget, 1);
rb_define_module_function(mDCL, "uscset", dcl_uscset, 2);
rb_define_module_function(mDCL, "uscstx", dcl_uscstx, 2);
rb_define_module_function(mDCL, "uscqnp", dcl_uscqnp, 0);
rb_define_module_function(mDCL, "uscqid", dcl_uscqid, 1);
rb_define_module_function(mDCL, "uscqcp", dcl_uscqcp, 1);
rb_define_module_function(mDCL, "uscqcl", dcl_uscqcl, 1);
rb_define_module_function(mDCL, "uscqvl", dcl_uscqvl, 1);
rb_define_module_function(mDCL, "uscsvl", dcl_uscsvl, 2);
rb_define_module_function(mDCL, "uscqin", dcl_uscqin, 1);
rb_define_module_function(mDCL, "usurdl", dcl_usurdl, 4);
rb_define_module_function(mDCL, "usxaxs", dcl_usxaxs, 1);
rb_define_module_function(mDCL, "usyaxs", dcl_usyaxs, 1);
rb_define_module_function(mDCL, "ususcu", dcl_ususcu, 6);
rb_define_module_function(mDCL, "ususcl", dcl_ususcl, 5);
rb_define_module_function(mDCL, "usxaxu", dcl_usxaxu, 1);
rb_define_module_function(mDCL, "usxaxl", dcl_usxaxl, 1);
rb_define_module_function(mDCL, "usyaxu", dcl_usyaxu, 1);
rb_define_module_function(mDCL, "usyaxl", dcl_usyaxl, 1);
rb_define_module_function(mDCL, "usxsub", dcl_usxsub, 4);
rb_define_module_function(mDCL, "usysub", dcl_usysub, 4);
rb_define_module_function(mDCL, "csblbl", dcl_csblbl, 3);
rb_define_module_function(mDCL, "uschvl", dcl_uschvl, 1);
rb_define_module_function(mDCL, "usxoff", dcl_usxoff, 1);
rb_define_module_function(mDCL, "usyoff", dcl_usyoff, 1);
rb_define_module_function(mDCL, "uszdgt", dcl_uszdgt, 6);
rb_define_module_function(mDCL, "uswapz", dcl_uswapz, 3);
rb_define_module_function(mDCL, "usurdt", dcl_usurdt, 4);
rb_define_module_function(mDCL, "usaxcl", dcl_usaxcl, 4);
rb_define_module_function(mDCL, "usaxdv", dcl_usaxdv, 3);
rb_define_module_function(mDCL, "usaxlb", dcl_usaxlb, 7);
rb_define_module_function(mDCL, "usaxlg", dcl_usaxlg, 3);
rb_define_module_function(mDCL, "usaxnm", dcl_usaxnm, 5);
rb_define_module_function(mDCL, "usaxsc", dcl_usaxsc, 1);
rb_define_module_function(mDCL, "usiget", dcl_usiget, 1);
rb_define_module_function(mDCL, "usiset", dcl_usiset, 2);
rb_define_module_function(mDCL, "usistx", dcl_usistx, 2);
rb_define_module_function(mDCL, "usiqnp", dcl_usiqnp, 0);
rb_define_module_function(mDCL, "usiqid", dcl_usiqid, 1);
rb_define_module_function(mDCL, "usiqcp", dcl_usiqcp, 1);
rb_define_module_function(mDCL, "usiqcl", dcl_usiqcl, 1);
rb_define_module_function(mDCL, "usiqvl", dcl_usiqvl, 1);
rb_define_module_function(mDCL, "usisvl", dcl_usisvl, 2);
rb_define_module_function(mDCL, "usiqin", dcl_usiqin, 1);
rb_define_module_function(mDCL, "uslget", dcl_uslget, 1);
rb_define_module_function(mDCL, "uslset", dcl_uslset, 2);
rb_define_module_function(mDCL, "uslstx", dcl_uslstx, 2);
rb_define_module_function(mDCL, "uslqnp", dcl_uslqnp, 0);
rb_define_module_function(mDCL, "uslqid", dcl_uslqid, 1);
rb_define_module_function(mDCL, "uslqcp", dcl_uslqcp, 1);
rb_define_module_function(mDCL, "uslqcl", dcl_uslqcl, 1);
rb_define_module_function(mDCL, "uslqvl", dcl_uslqvl, 1);
rb_define_module_function(mDCL, "uslsvl", dcl_uslsvl, 2);
rb_define_module_function(mDCL, "uslqin", dcl_uslqin, 1);
rb_define_module_function(mDCL, "uspaxs", dcl_uspaxs, 2);
rb_define_module_function(mDCL, "usplbl", dcl_usplbl, 6);
rb_define_module_function(mDCL, "uspnum", dcl_uspnum, 4);
rb_define_module_function(mDCL, "usptmk", dcl_usptmk, 4);
rb_define_module_function(mDCL, "uspttl", dcl_uspttl, 4);
rb_define_module_function(mDCL, "usrget", dcl_usrget, 1);
rb_define_module_function(mDCL, "usrset", dcl_usrset, 2);
rb_define_module_function(mDCL, "usrstx", dcl_usrstx, 2);
rb_define_module_function(mDCL, "usrqnp", dcl_usrqnp, 0);
rb_define_module_function(mDCL, "usrqid", dcl_usrqid, 1);
rb_define_module_function(mDCL, "usrqcp", dcl_usrqcp, 1);
rb_define_module_function(mDCL, "usrqcl", dcl_usrqcl, 1);
rb_define_module_function(mDCL, "usrqvl", dcl_usrqvl, 1);
rb_define_module_function(mDCL, "usrsvl", dcl_usrsvl, 2);
rb_define_module_function(mDCL, "usrqin", dcl_usrqin, 1);
rb_define_module_function(mDCL, "ussaxs", dcl_ussaxs, 1);
rb_define_module_function(mDCL, "usxinz", dcl_usxinz, 1);
rb_define_module_function(mDCL, "usxtlz", dcl_usxtlz, 0);
rb_define_module_function(mDCL, "usyinz", dcl_usyinz, 1);
rb_define_module_function(mDCL, "usytlz", dcl_usytlz, 0);
}
syntax highlighted by Code2HTML, v. 0.9.1