/*
* $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_umpmap(obj, cdsn)
VALUE obj, cdsn;
{
char *i_cdsn;
if (TYPE(cdsn) != T_STRING) {
cdsn = rb_funcall(cdsn, rb_intern("to_str"), 0);
}
i_cdsn = STR2CSTR(cdsn);
umpmap_(i_cdsn, (ftnlen)strlen(i_cdsn));
return Qnil;
}
static VALUE
dcl_umqfnm(obj, cpara)
VALUE obj, cpara;
{
char *i_cpara;
char *o_cfname;
VALUE cfname;
if (TYPE(cpara) != T_STRING) {
cpara = rb_funcall(cpara, rb_intern("to_str"), 0);
}
i_cpara = STR2CSTR(cpara);
o_cfname= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_cfname, '\0', DFLT_SIZE+1);
umqfnm_(i_cpara, o_cfname, (ftnlen)strlen(i_cpara), (ftnlen)DFLT_SIZE);
cfname = rb_str_new2(o_cfname);
return cfname;
}
static VALUE
dcl_umpglb(obj)
VALUE obj;
{
umpglb_();
return Qnil;
}
static VALUE
dcl_umpgrd(obj)
VALUE obj;
{
umpgrd_();
return Qnil;
}
static VALUE
dcl_umplim(obj)
VALUE obj;
{
umplim_();
return Qnil;
}
static VALUE
dcl_uminit(obj)
VALUE obj;
{
uminit_();
return Qnil;
}
static VALUE
dcl_umscnt(obj, xcnt, ycnt, rot)
VALUE obj, xcnt, ycnt, rot;
{
real i_xcnt;
real i_ycnt;
real i_rot;
if (TYPE(xcnt) != T_FLOAT) {
xcnt = rb_funcall(xcnt, rb_intern("to_f"), 0);
}
if (TYPE(ycnt) != T_FLOAT) {
ycnt = rb_funcall(ycnt, rb_intern("to_f"), 0);
}
if (TYPE(rot) != T_FLOAT) {
rot = rb_funcall(rot, rb_intern("to_f"), 0);
}
i_xcnt = (real)NUM2DBL(xcnt);
i_ycnt = (real)NUM2DBL(ycnt);
i_rot = (real)NUM2DBL(rot);
umscnt_(&i_xcnt, &i_ycnt, &i_rot);
return Qnil;
}
static VALUE
dcl_umqcnt(obj)
VALUE obj;
{
real o_xcnt;
real o_ycnt;
real o_rot;
VALUE xcnt;
VALUE ycnt;
VALUE rot;
umqcnt_(&o_xcnt, &o_ycnt, &o_rot);
xcnt = rb_float_new((double)o_xcnt);
ycnt = rb_float_new((double)o_ycnt);
rot = rb_float_new((double)o_rot);
return rb_ary_new3(3, xcnt, ycnt, rot);
}
static VALUE
dcl_umscwd(obj, xcntr, ycntr, r)
VALUE obj, xcntr, ycntr, r;
{
real i_xcntr;
real i_ycntr;
real i_r;
if (TYPE(xcntr) != T_FLOAT) {
xcntr = rb_funcall(xcntr, rb_intern("to_f"), 0);
}
if (TYPE(ycntr) != T_FLOAT) {
ycntr = rb_funcall(ycntr, rb_intern("to_f"), 0);
}
if (TYPE(r) != T_FLOAT) {
r = rb_funcall(r, rb_intern("to_f"), 0);
}
i_xcntr = (real)NUM2DBL(xcntr);
i_ycntr = (real)NUM2DBL(ycntr);
i_r = (real)NUM2DBL(r);
umscwd_(&i_xcntr, &i_ycntr, &i_r);
return Qnil;
}
static VALUE
dcl_umqcwd(obj)
VALUE obj;
{
real o_xcntr;
real o_ycntr;
real o_r;
VALUE xcntr;
VALUE ycntr;
VALUE r;
umqcwd_(&o_xcntr, &o_ycntr, &o_r);
xcntr = rb_float_new((double)o_xcntr);
ycntr = rb_float_new((double)o_ycntr);
r = rb_float_new((double)o_r);
return rb_ary_new3(3, xcntr, ycntr, r);
}
static VALUE
dcl_umspnt(obj, n, ux, uy)
VALUE obj, n, ux, uy;
{
integer i_n;
real *i_ux;
real *i_uy;
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
if (TYPE(ux) == T_FLOAT) {
ux = rb_Array(ux);
}
/* if ((TYPE(ux) != T_ARRAY) &&
(rb_obj_is_kind_of(ux, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if (TYPE(uy) == T_FLOAT) {
uy = rb_Array(uy);
}
/* if ((TYPE(uy) != T_ARRAY) &&
(rb_obj_is_kind_of(uy, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
i_n = NUM2INT(n);
i_ux = dcl_obj2crealary(ux);
i_uy = dcl_obj2crealary(uy);
umspnt_(&i_n, i_ux, i_uy);
dcl_freecrealary(i_ux);
dcl_freecrealary(i_uy);
return Qnil;
}
static VALUE
dcl_umqpnt(obj, n)
VALUE obj, n;
{
integer i_n;
real o_uxa;
real o_uya;
VALUE uxa;
VALUE uya;
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
n = rb_funcall(n, rb_intern("to_i"), 0);
}
i_n = NUM2INT(n);
umqpnt_(&i_n, &o_uxa, &o_uya);
uxa = rb_float_new((double)o_uxa);
uya = rb_float_new((double)o_uya);
return rb_ary_new3(2, uxa, uya);
}
static VALUE
dcl_umqptn(obj)
VALUE obj;
{
integer o_n;
VALUE n;
umqptn_(&o_n);
n = INT2NUM(o_n);
return n;
}
static VALUE
dcl_umrpnt(obj)
VALUE obj;
{
umrpnt_();
return Qnil;
}
static VALUE
dcl_umpfit(obj)
VALUE obj;
{
umpfit_();
return Qnil;
}
static VALUE
dcl_umpqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
umpqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_umpqid(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);
umpqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_umpqcp(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);
umpqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umpqcl(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);
umpqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umpqit(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);
umpqit_(&i_idx, &o_itp);
itp = INT2NUM(o_itp);
return itp;
}
static VALUE
dcl_umpqvl(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);
umpqvl_(&i_idx, &o_ipara);
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_umpsvl(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);
umpsvl_(&i_idx, &i_ipara);
return Qnil;
}
static VALUE
dcl_umpqin(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);
umpqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_umspct(obj)
VALUE obj;
{
umspct_();
return Qnil;
}
static VALUE
dcl_umspcw(obj)
VALUE obj;
{
umspcw_();
return Qnil;
}
static VALUE
dcl_umspwd(obj)
VALUE obj;
{
umspwd_();
return Qnil;
}
static VALUE
dcl_umsppt(obj)
VALUE obj;
{
umsppt_();
return Qnil;
}
static VALUE
dcl_umspdf(obj)
VALUE obj;
{
umspdf_();
return Qnil;
}
static VALUE
dcl_umbndc(obj, xmin)
VALUE obj, xmin;
{
real io_xmin;
real o_xmax;
real o_ymin;
real o_ymax;
VALUE xmax;
VALUE ymin;
VALUE ymax;
if (TYPE(xmin) != T_FLOAT) {
xmin = rb_funcall(xmin, rb_intern("to_f"), 0);
}
io_xmin = (real)NUM2DBL(xmin);
umbndc_(&io_xmin, &o_xmax, &o_ymin, &o_ymax);
xmin = rb_float_new((double)io_xmin);
xmax = rb_float_new((double)o_xmax);
ymin = rb_float_new((double)o_ymin);
ymax = rb_float_new((double)o_ymax);
return rb_ary_new3(4, xmin, xmax, ymin, ymax);
}
static VALUE
dcl_umbndp(obj, vxmin)
VALUE obj, vxmin;
{
real io_vxmin;
real o_vxmax;
real o_vymin;
real o_vymax;
VALUE vxmax;
VALUE vymin;
VALUE vymax;
if (TYPE(vxmin) != T_FLOAT) {
vxmin = rb_funcall(vxmin, rb_intern("to_f"), 0);
}
io_vxmin = (real)NUM2DBL(vxmin);
umbndp_(&io_vxmin, &o_vxmax, &o_vymin, &o_vymax);
vxmin = rb_float_new((double)io_vxmin);
vxmax = rb_float_new((double)o_vxmax);
vymin = rb_float_new((double)o_vymin);
vymax = rb_float_new((double)o_vymax);
return rb_ary_new3(4, vxmin, vxmax, vymin, vymax);
}
static VALUE
dcl_umbndr(obj, func, ftr)
VALUE obj, func, ftr;
{
real i_func;
real i_ftr;
real o_xmin;
real o_xmax;
real o_ymin;
real o_ymax;
VALUE xmin;
VALUE xmax;
VALUE ymin;
VALUE ymax;
if (TYPE(func) != T_FLOAT) {
func = rb_funcall(func, rb_intern("to_f"), 0);
}
if (TYPE(ftr) != T_FLOAT) {
ftr = rb_funcall(ftr, rb_intern("to_f"), 0);
}
i_func = (real)NUM2DBL(func);
i_ftr = (real)NUM2DBL(ftr);
umbndr_(&i_func, &i_ftr, &o_xmin, &o_xmax, &o_ymin, &o_ymax);
xmin = rb_float_new((double)o_xmin);
xmax = rb_float_new((double)o_xmax);
ymin = rb_float_new((double)o_ymin);
ymax = rb_float_new((double)o_ymax);
return rb_ary_new3(4, xmin, xmax, ymin, ymax);
}
static VALUE
dcl_umqtxy(obj)
VALUE obj;
{
real o_txminz;
real o_txmaxz;
real o_tyminz;
real o_tymaxz;
VALUE txminz;
VALUE txmaxz;
VALUE tyminz;
VALUE tymaxz;
umqtxy_(&o_txminz, &o_txmaxz, &o_tyminz, &o_tymaxz);
txminz = rb_float_new((double)o_txminz);
txmaxz = rb_float_new((double)o_txmaxz);
tyminz = rb_float_new((double)o_tyminz);
tymaxz = rb_float_new((double)o_tymaxz);
return rb_ary_new3(4, txminz, txmaxz, tyminz, tymaxz);
}
static VALUE
dcl_umstvz(obj)
VALUE obj;
{
umstvz_();
return Qnil;
}
static VALUE
dcl_umsgrd(obj)
VALUE obj;
{
umsgrd_();
return Qnil;
}
static VALUE
dcl_umscom(obj)
VALUE obj;
{
umscom_();
return Qnil;
}
static VALUE
dcl_umiget(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);
umiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp));
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_umiset(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);
umiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_umistx(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);
umistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_umiqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
umiqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_umiqid(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);
umiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_umiqcp(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);
umiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umiqcl(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);
umiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umiqvl(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);
umiqvl_(&i_idx, &o_ipara);
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_umisvl(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);
umisvl_(&i_idx, &i_ipara);
return Qnil;
}
static VALUE
dcl_umiqin(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);
umiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_umlget(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);
umlget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp));
lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
return lpara;
}
static VALUE
dcl_umlset(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_;
umlset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_umlstx(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_;
umlstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_umlqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
umlqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_umlqid(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);
umlqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_umlqcp(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);
umlqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umlqcl(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);
umlqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umlqvl(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);
umlqvl_(&i_idx, &o_lpara);
lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
return lpara;
}
static VALUE
dcl_umlsvl(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_;
umlsvl_(&i_idx, &i_lpara);
return Qnil;
}
static VALUE
dcl_umlqin(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);
umlqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_umrget(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);
umrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp));
rpara = rb_float_new((double)o_rpara);
return rpara;
}
static VALUE
dcl_umrset(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);
umrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_umrstx(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);
umrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_umrqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
umrqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_umrqid(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);
umrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_umrqcp(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);
umrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umrqcl(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);
umrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_umrqvl(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);
umrqvl_(&i_idx, &o_rpara);
rpara = rb_float_new((double)o_rpara);
return rpara;
}
static VALUE
dcl_umrsvl(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);
umrsvl_(&i_idx, &i_rpara);
return Qnil;
}
static VALUE
dcl_umrqin(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);
umrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
#if DCLVER >= 53
static VALUE
dcl_umfmap(obj, cdsn)
VALUE obj, cdsn;
{
char *i_cdsn;
if (TYPE(cdsn) != T_STRING) {
cdsn = rb_funcall(cdsn, rb_intern("to_str"), 0);
}
i_cdsn = STR2CSTR(cdsn);
umfmap_(i_cdsn, (ftnlen)strlen(i_cdsn));
return Qnil;
}
#endif
void
init_grph2_umpack(mDCL)
VALUE mDCL;
{
rb_define_module_function(mDCL, "umpmap", dcl_umpmap, 1);
rb_define_module_function(mDCL, "umqfnm", dcl_umqfnm, 1);
rb_define_module_function(mDCL, "umpglb", dcl_umpglb, 0);
rb_define_module_function(mDCL, "umpgrd", dcl_umpgrd, 0);
rb_define_module_function(mDCL, "umplim", dcl_umplim, 0);
rb_define_module_function(mDCL, "uminit", dcl_uminit, 0);
rb_define_module_function(mDCL, "umscnt", dcl_umscnt, 3);
rb_define_module_function(mDCL, "umqcnt", dcl_umqcnt, 0);
rb_define_module_function(mDCL, "umscwd", dcl_umscwd, 3);
rb_define_module_function(mDCL, "umqcwd", dcl_umqcwd, 0);
rb_define_module_function(mDCL, "umspnt", dcl_umspnt, 3);
rb_define_module_function(mDCL, "umqpnt", dcl_umqpnt, 1);
rb_define_module_function(mDCL, "umqptn", dcl_umqptn, 0);
rb_define_module_function(mDCL, "umrpnt", dcl_umrpnt, 0);
rb_define_module_function(mDCL, "umpfit", dcl_umpfit, 0);
rb_define_module_function(mDCL, "umpqnp", dcl_umpqnp, 0);
rb_define_module_function(mDCL, "umpqid", dcl_umpqid, 1);
rb_define_module_function(mDCL, "umpqcp", dcl_umpqcp, 1);
rb_define_module_function(mDCL, "umpqcl", dcl_umpqcl, 1);
rb_define_module_function(mDCL, "umpqit", dcl_umpqit, 1);
rb_define_module_function(mDCL, "umpqvl", dcl_umpqvl, 1);
rb_define_module_function(mDCL, "umpsvl", dcl_umpsvl, 2);
rb_define_module_function(mDCL, "umpqin", dcl_umpqin, 1);
rb_define_module_function(mDCL, "umspct", dcl_umspct, 0);
rb_define_module_function(mDCL, "umspcw", dcl_umspcw, 0);
rb_define_module_function(mDCL, "umspwd", dcl_umspwd, 0);
rb_define_module_function(mDCL, "umsppt", dcl_umsppt, 0);
rb_define_module_function(mDCL, "umspdf", dcl_umspdf, 0);
rb_define_module_function(mDCL, "umbndc", dcl_umbndc, 1);
rb_define_module_function(mDCL, "umbndp", dcl_umbndp, 1);
rb_define_module_function(mDCL, "umbndr", dcl_umbndr, 2);
rb_define_module_function(mDCL, "umqtxy", dcl_umqtxy, 0);
rb_define_module_function(mDCL, "umstvz", dcl_umstvz, 0);
rb_define_module_function(mDCL, "umsgrd", dcl_umsgrd, 0);
rb_define_module_function(mDCL, "umscom", dcl_umscom, 0);
rb_define_module_function(mDCL, "umiget", dcl_umiget, 1);
rb_define_module_function(mDCL, "umiset", dcl_umiset, 2);
rb_define_module_function(mDCL, "umistx", dcl_umistx, 2);
rb_define_module_function(mDCL, "umiqnp", dcl_umiqnp, 0);
rb_define_module_function(mDCL, "umiqid", dcl_umiqid, 1);
rb_define_module_function(mDCL, "umiqcp", dcl_umiqcp, 1);
rb_define_module_function(mDCL, "umiqcl", dcl_umiqcl, 1);
rb_define_module_function(mDCL, "umiqvl", dcl_umiqvl, 1);
rb_define_module_function(mDCL, "umisvl", dcl_umisvl, 2);
rb_define_module_function(mDCL, "umiqin", dcl_umiqin, 1);
rb_define_module_function(mDCL, "umlget", dcl_umlget, 1);
rb_define_module_function(mDCL, "umlset", dcl_umlset, 2);
rb_define_module_function(mDCL, "umlstx", dcl_umlstx, 2);
rb_define_module_function(mDCL, "umlqnp", dcl_umlqnp, 0);
rb_define_module_function(mDCL, "umlqid", dcl_umlqid, 1);
rb_define_module_function(mDCL, "umlqcp", dcl_umlqcp, 1);
rb_define_module_function(mDCL, "umlqcl", dcl_umlqcl, 1);
rb_define_module_function(mDCL, "umlqvl", dcl_umlqvl, 1);
rb_define_module_function(mDCL, "umlsvl", dcl_umlsvl, 2);
rb_define_module_function(mDCL, "umlqin", dcl_umlqin, 1);
rb_define_module_function(mDCL, "umrget", dcl_umrget, 1);
rb_define_module_function(mDCL, "umrset", dcl_umrset, 2);
rb_define_module_function(mDCL, "umrstx", dcl_umrstx, 2);
rb_define_module_function(mDCL, "umrqnp", dcl_umrqnp, 0);
rb_define_module_function(mDCL, "umrqid", dcl_umrqid, 1);
rb_define_module_function(mDCL, "umrqcp", dcl_umrqcp, 1);
rb_define_module_function(mDCL, "umrqcl", dcl_umrqcl, 1);
rb_define_module_function(mDCL, "umrqvl", dcl_umrqvl, 1);
rb_define_module_function(mDCL, "umrsvl", dcl_umrsvl, 2);
rb_define_module_function(mDCL, "umrqin", dcl_umrqin, 1);
#if DCLVER >= 53
rb_define_module_function(mDCL, "umfmap", dcl_umfmap, 1);
#endif
}
syntax highlighted by Code2HTML, v. 0.9.1