/*
* $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_swdopn(obj)
VALUE obj;
{
swdopn_();
return Qnil;
}
static VALUE
dcl_swdcls(obj)
VALUE obj;
{
swdcls_();
return Qnil;
}
static VALUE
dcl_swpopn(obj)
VALUE obj;
{
swpopn_();
return Qnil;
}
static VALUE
dcl_swpcls(obj)
VALUE obj;
{
swpcls_();
return Qnil;
}
static VALUE
dcl_swoopn(obj, cobj, comm)
VALUE obj, cobj, comm;
{
char *i_cobj;
char *i_comm;
if (TYPE(cobj) != T_STRING) {
cobj = rb_funcall(cobj, rb_intern("to_str"), 0);
}
if (TYPE(comm) != T_STRING) {
comm = rb_funcall(comm, rb_intern("to_str"), 0);
}
i_cobj = STR2CSTR(cobj);
i_comm = STR2CSTR(comm);
swoopn_(i_cobj, i_comm, (ftnlen)strlen(i_cobj), (ftnlen)strlen(i_comm));
return Qnil;
}
static VALUE
dcl_swocls(obj, cobj)
VALUE obj, cobj;
{
char *i_cobj;
if (TYPE(cobj) != T_STRING) {
cobj = rb_funcall(cobj, rb_intern("to_str"), 0);
}
i_cobj = STR2CSTR(cobj);
swocls_(i_cobj, (ftnlen)strlen(i_cobj));
return Qnil;
}
static VALUE
dcl_swswdi(obj, iwdidx)
VALUE obj, iwdidx;
{
integer i_iwdidx;
if ((TYPE(iwdidx) != T_BIGNUM) || (TYPE(iwdidx) != T_FIXNUM)) {
iwdidx = rb_funcall(iwdidx, rb_intern("to_i"), 0);
}
i_iwdidx = NUM2INT(iwdidx);
swswdi_(&i_iwdidx);
return Qnil;
}
static VALUE
dcl_swscli(obj, iclidx)
VALUE obj, iclidx;
{
integer i_iclidx;
if ((TYPE(iclidx) != T_BIGNUM) || (TYPE(iclidx) != T_FIXNUM)) {
iclidx = rb_funcall(iclidx, rb_intern("to_i"), 0);
}
i_iclidx = NUM2INT(iclidx);
swscli_(&i_iclidx);
return Qnil;
}
static VALUE
dcl_swgopn(obj)
VALUE obj;
{
swgopn_();
return Qnil;
}
static VALUE
dcl_swgmov(obj, wx, wy)
VALUE obj, wx, wy;
{
real i_wx;
real i_wy;
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);
swgmov_(&i_wx, &i_wy);
return Qnil;
}
static VALUE
dcl_swgplt(obj, wx, wy)
VALUE obj, wx, wy;
{
real i_wx;
real i_wy;
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);
swgplt_(&i_wx, &i_wy);
return Qnil;
}
static VALUE
dcl_swgcls(obj)
VALUE obj;
{
swgcls_();
return Qnil;
}
static VALUE
dcl_swgton(obj, np, wpx, wpy, itpat)
VALUE obj, np, wpx, wpy, itpat;
{
integer i_np;
real *i_wpx;
real *i_wpy;
integer i_itpat;
if ((TYPE(np) != T_BIGNUM) || (TYPE(np) != T_FIXNUM)) {
np = rb_funcall(np, rb_intern("to_i"), 0);
}
if (TYPE(wpx) == T_FLOAT) {
wpx = rb_Array(wpx);
}
/* if ((TYPE(wpx) != T_ARRAY) &&
(rb_obj_is_kind_of(wpx, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if (TYPE(wpy) == T_FLOAT) {
wpy = rb_Array(wpy);
}
/* if ((TYPE(wpy) != T_ARRAY) &&
(rb_obj_is_kind_of(wpy, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(itpat) != T_BIGNUM) || (TYPE(itpat) != T_FIXNUM)) {
itpat = rb_funcall(itpat, rb_intern("to_i"), 0);
}
i_np = NUM2INT(np);
i_itpat = NUM2INT(itpat);
i_wpx = dcl_obj2crealary(wpx);
i_wpy = dcl_obj2crealary(wpy);
swgton_(&i_np, i_wpx, i_wpy, &i_itpat);
dcl_freecrealary(i_wpx);
dcl_freecrealary(i_wpy);
return Qnil;
}
static VALUE
dcl_swiopn(obj, iwx, iwy, imw, imh)
VALUE obj, iwx, iwy, imw, imh;
{
integer i_iwx;
integer i_iwy;
integer i_imw;
integer i_imh;
if ((TYPE(iwx) != T_BIGNUM) || (TYPE(iwx) != T_FIXNUM)) {
iwx = rb_funcall(iwx, rb_intern("to_i"), 0);
}
if ((TYPE(iwy) != T_BIGNUM) || (TYPE(iwy) != T_FIXNUM)) {
iwy = rb_funcall(iwy, rb_intern("to_i"), 0);
}
if ((TYPE(imw) != T_BIGNUM) || (TYPE(imw) != T_FIXNUM)) {
imw = rb_funcall(imw, rb_intern("to_i"), 0);
}
if ((TYPE(imh) != T_BIGNUM) || (TYPE(imh) != T_FIXNUM)) {
imh = rb_funcall(imh, rb_intern("to_i"), 0);
}
i_iwx = NUM2INT(iwx);
i_iwy = NUM2INT(iwy);
i_imw = NUM2INT(imw);
i_imh = NUM2INT(imh);
swiopn_(&i_iwx, &i_iwy, &i_imw, &i_imh);
return Qnil;
}
static VALUE
dcl_swidat(obj, image, nlen)
VALUE obj, image, nlen;
{
integer *i_image;
integer i_nlen;
if ((TYPE(image) == T_BIGNUM) || (TYPE(image) == T_FIXNUM)) {
image = rb_Array(image);
}
/* if ((TYPE(image) != T_ARRAY) &&
(rb_obj_is_kind_of(image, cNArray) != Qtrue)) {
rb_raise(rb_eTypeError, "invalid type");
} -- no check since obj2c*ary will do that */
if ((TYPE(nlen) != T_BIGNUM) || (TYPE(nlen) != T_FIXNUM)) {
nlen = rb_funcall(nlen, rb_intern("to_i"), 0);
}
i_nlen = NUM2INT(nlen);
i_image = dcl_obj2cintegerary(image);
swidat_(i_image, &i_nlen);
dcl_freecintegerary(i_image);
return Qnil;
}
static VALUE
dcl_swicls(obj)
VALUE obj;
{
swicls_();
return Qnil;
}
static VALUE
dcl_swqpnt(obj)
VALUE obj;
{
real o_wx;
real o_wy;
integer o_mb;
VALUE wx;
VALUE wy;
VALUE mb;
swqpnt_(&o_wx, &o_wy, &o_mb);
wx = rb_float_new((double)o_wx);
wy = rb_float_new((double)o_wy);
mb = INT2NUM(o_mb);
return rb_ary_new3(3, wx, wy, mb);
}
static VALUE
dcl_swfint(obj, wx, wy)
VALUE obj, wx, wy;
{
real i_wx;
real i_wy;
integer o_iwx;
integer o_iwy;
VALUE iwx;
VALUE iwy;
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);
swfint_(&i_wx, &i_wy, &o_iwx, &o_iwy);
iwx = INT2NUM(o_iwx);
iwy = INT2NUM(o_iwy);
return rb_ary_new3(2, iwx, iwy);
}
static VALUE
dcl_swiint(obj, iwx, iwy)
VALUE obj, iwx, iwy;
{
integer i_iwx;
integer i_iwy;
real o_wx;
real o_wy;
VALUE wx;
VALUE wy;
if ((TYPE(iwx) != T_BIGNUM) || (TYPE(iwx) != T_FIXNUM)) {
iwx = rb_funcall(iwx, rb_intern("to_i"), 0);
}
if ((TYPE(iwy) != T_BIGNUM) || (TYPE(iwy) != T_FIXNUM)) {
iwy = rb_funcall(iwy, rb_intern("to_i"), 0);
}
i_iwx = NUM2INT(iwx);
i_iwy = NUM2INT(iwy);
swiint_(&i_iwx, &i_iwy, &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_swqwdc(obj)
VALUE obj;
{
logical o_lwdatr;
VALUE lwdatr;
swqwdc_(&o_lwdatr);
lwdatr = (o_lwdatr == FALSE_) ? Qfalse : Qtrue;
return lwdatr;
}
static VALUE
dcl_swqclc(obj)
VALUE obj;
{
logical o_lclatr;
VALUE lclatr;
swqclc_(&o_lclatr);
lclatr = (o_lclatr == FALSE_) ? Qfalse : Qtrue;
return lclatr;
}
static VALUE
dcl_swqtnc(obj)
VALUE obj;
{
logical o_ltnatr;
VALUE ltnatr;
swqtnc_(&o_ltnatr);
ltnatr = (o_ltnatr == FALSE_) ? Qfalse : Qtrue;
return ltnatr;
}
static VALUE
dcl_swqimc(obj)
VALUE obj;
{
logical o_limatr;
VALUE limatr;
swqimc_(&o_limatr);
limatr = (o_limatr == FALSE_) ? Qfalse : Qtrue;
return limatr;
}
static VALUE
dcl_swqptc(obj)
VALUE obj;
{
logical o_lptatr;
VALUE lptatr;
swqptc_(&o_lptatr);
lptatr = (o_lptatr == FALSE_) ? Qfalse : Qtrue;
return lptatr;
}
static VALUE
dcl_swqrct(obj)
VALUE obj;
{
real o_wsxmn;
real o_wsxmx;
real o_wsymn;
real o_wsymx;
real o_fact;
VALUE wsxmn;
VALUE wsxmx;
VALUE wsymn;
VALUE wsymx;
VALUE fact;
swqrct_(&o_wsxmn, &o_wsxmx, &o_wsymn, &o_wsymx, &o_fact);
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);
fact = rb_float_new((double)o_fact);
return rb_ary_new3(5, wsxmn, wsxmx, wsymn, wsymx, fact);
}
static VALUE
dcl_swsrot(obj, iwtrot)
VALUE obj, iwtrot;
{
integer i_iwtrot;
if ((TYPE(iwtrot) != T_BIGNUM) || (TYPE(iwtrot) != T_FIXNUM)) {
iwtrot = rb_funcall(iwtrot, rb_intern("to_i"), 0);
}
i_iwtrot = NUM2INT(iwtrot);
swsrot_(&i_iwtrot);
return Qnil;
}
static VALUE
dcl_swpqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
swpqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_swpqid(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);
swpqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_swpqcp(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);
swpqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swpqcl(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);
swpqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swpqit(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);
swpqit_(&i_idx, &o_itp);
itp = INT2NUM(o_itp);
return itp;
}
static VALUE
dcl_swpqvl(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);
swpqvl_(&i_idx, &o_ipara);
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_swpsvl(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);
swpsvl_(&i_idx, &i_ipara);
return Qnil;
}
static VALUE
dcl_swpqin(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);
swpqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_swcget(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);
swcget_(i_cp, o_cpara, (ftnlen)strlen(i_cp), (ftnlen)DFLT_SIZE);
cpara = rb_str_new2(o_cpara);
return cpara;
}
static VALUE
dcl_swcset(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);
swcset_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara));
return Qnil;
}
static VALUE
dcl_swcstx(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);
swcstx_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara));
return Qnil;
}
static VALUE
dcl_swqfnm(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);
swqfnm_(i_cpara, o_cfname, (ftnlen)strlen(i_cpara), (ftnlen)DFLT_SIZE);
cfname = rb_str_new2(o_cfname);
return cfname;
}
static VALUE
dcl_swcqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
swcqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_swcqid(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);
swcqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_swcqcp(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);
swcqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swcqcl(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);
swcqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swcqvl(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);
swcqvl_(&i_idx, o_cval, (ftnlen)DFLT_SIZE);
cval = rb_str_new2(o_cval);
return cval;
}
static VALUE
dcl_swcsvl(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);
swcsvl_(&i_idx, i_cval, (ftnlen)strlen(i_cval));
return Qnil;
}
static VALUE
dcl_swcqin(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);
swcqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_swiget(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);
swiget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp));
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_swiset(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);
swiset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_swistx(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);
swistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_swiqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
swiqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_swiqid(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);
swiqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_swiqcp(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);
swiqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swiqcl(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);
swiqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swiqvl(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);
swiqvl_(&i_idx, &o_ipara);
ipara = INT2NUM(o_ipara);
return ipara;
}
static VALUE
dcl_swisvl(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);
swisvl_(&i_idx, &i_ipara);
return Qnil;
}
static VALUE
dcl_swiqin(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);
swiqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_swlget(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);
swlget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp));
lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
return lpara;
}
static VALUE
dcl_swlset(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_;
swlset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_swlstx(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_;
swlstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_swlqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
swlqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_swlqid(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);
swlqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_swlqcp(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);
swlqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swlqcl(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);
swlqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swlqvl(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);
swlqvl_(&i_idx, &o_lpara);
lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
return lpara;
}
static VALUE
dcl_swlsvl(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_;
swlsvl_(&i_idx, &i_lpara);
return Qnil;
}
static VALUE
dcl_swlqin(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);
swlqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
static VALUE
dcl_swrget(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);
swrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp));
rpara = rb_float_new((double)o_rpara);
return rpara;
}
static VALUE
dcl_swrset(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);
swrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_swrstx(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);
swrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
return Qnil;
}
static VALUE
dcl_swrqnp(obj)
VALUE obj;
{
integer o_ncp;
VALUE ncp;
swrqnp_(&o_ncp);
ncp = INT2NUM(o_ncp);
return ncp;
}
static VALUE
dcl_swrqid(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);
swrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp));
idx = INT2NUM(o_idx);
return idx;
}
static VALUE
dcl_swrqcp(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);
swrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swrqcl(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);
swrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
cp = rb_str_new2(o_cp);
return cp;
}
static VALUE
dcl_swrqvl(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);
swrqvl_(&i_idx, &o_rpara);
rpara = rb_float_new((double)o_rpara);
return rpara;
}
static VALUE
dcl_swrsvl(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);
swrsvl_(&i_idx, &i_rpara);
return Qnil;
}
static VALUE
dcl_swrqin(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);
swrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp));
in = INT2NUM(o_in);
return in;
}
#if DCLVER >= 53
static VALUE
dcl_swcmll(obj)
VALUE obj;
{
swcmll_();
return Qnil;
}
#endif
#if DCLVER >= 53
static VALUE
dcl_swqcmn(obj)
VALUE obj;
{
integer o_nn;
VALUE nn;
swqcmn_(&o_nn);
nn = INT2NUM(o_nn);
return nn;
}
#endif
#if DCLVER >= 53
static VALUE
dcl_swqcmf(obj, ntx)
VALUE obj, ntx;
{
integer i_ntx;
char *o_ctf;
VALUE ctf;
if ((TYPE(ntx) != T_BIGNUM) || (TYPE(ntx) != T_FIXNUM)) {
ntx = rb_funcall(ntx, rb_intern("to_i"), 0);
}
i_ntx = NUM2INT(ntx);
o_ctf= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_ctf, '\0', DFLT_SIZE+1);
swqcmf_(&i_ntx, o_ctf, (ftnlen)DFLT_SIZE);
ctf = rb_str_new2(o_ctf);
return ctf;
}
#endif
#if DCLVER >= 53
static VALUE
dcl_swqcmd(obj, ntx)
VALUE obj, ntx;
{
integer i_ntx;
char *o_ctd;
VALUE ctd;
if ((TYPE(ntx) != T_BIGNUM) || (TYPE(ntx) != T_FIXNUM)) {
ntx = rb_funcall(ntx, rb_intern("to_i"), 0);
}
i_ntx = NUM2INT(ntx);
o_ctd= ALLOCA_N(char, (DFLT_SIZE+1));
memset(o_ctd, '\0', DFLT_SIZE+1);
swqcmd_(&i_ntx, o_ctd, (ftnlen)DFLT_SIZE);
ctd = rb_str_new2(o_ctd);
return ctd;
}
#endif
void
init_grph1_swpack(mDCL)
VALUE mDCL;
{
rb_define_module_function(mDCL, "swdopn", dcl_swdopn, 0);
rb_define_module_function(mDCL, "swdcls", dcl_swdcls, 0);
rb_define_module_function(mDCL, "swpopn", dcl_swpopn, 0);
rb_define_module_function(mDCL, "swpcls", dcl_swpcls, 0);
rb_define_module_function(mDCL, "swoopn", dcl_swoopn, 2);
rb_define_module_function(mDCL, "swocls", dcl_swocls, 1);
rb_define_module_function(mDCL, "swswdi", dcl_swswdi, 1);
rb_define_module_function(mDCL, "swscli", dcl_swscli, 1);
rb_define_module_function(mDCL, "swgopn", dcl_swgopn, 0);
rb_define_module_function(mDCL, "swgmov", dcl_swgmov, 2);
rb_define_module_function(mDCL, "swgplt", dcl_swgplt, 2);
rb_define_module_function(mDCL, "swgcls", dcl_swgcls, 0);
rb_define_module_function(mDCL, "swgton", dcl_swgton, 4);
rb_define_module_function(mDCL, "swiopn", dcl_swiopn, 4);
rb_define_module_function(mDCL, "swidat", dcl_swidat, 2);
rb_define_module_function(mDCL, "swicls", dcl_swicls, 0);
rb_define_module_function(mDCL, "swqpnt", dcl_swqpnt, 0);
rb_define_module_function(mDCL, "swfint", dcl_swfint, 2);
rb_define_module_function(mDCL, "swiint", dcl_swiint, 2);
rb_define_module_function(mDCL, "swqwdc", dcl_swqwdc, 0);
rb_define_module_function(mDCL, "swqclc", dcl_swqclc, 0);
rb_define_module_function(mDCL, "swqtnc", dcl_swqtnc, 0);
rb_define_module_function(mDCL, "swqimc", dcl_swqimc, 0);
rb_define_module_function(mDCL, "swqptc", dcl_swqptc, 0);
rb_define_module_function(mDCL, "swqrct", dcl_swqrct, 0);
rb_define_module_function(mDCL, "swsrot", dcl_swsrot, 1);
rb_define_module_function(mDCL, "swpqnp", dcl_swpqnp, 0);
rb_define_module_function(mDCL, "swpqid", dcl_swpqid, 1);
rb_define_module_function(mDCL, "swpqcp", dcl_swpqcp, 1);
rb_define_module_function(mDCL, "swpqcl", dcl_swpqcl, 1);
rb_define_module_function(mDCL, "swpqit", dcl_swpqit, 1);
rb_define_module_function(mDCL, "swpqvl", dcl_swpqvl, 1);
rb_define_module_function(mDCL, "swpsvl", dcl_swpsvl, 2);
rb_define_module_function(mDCL, "swpqin", dcl_swpqin, 1);
rb_define_module_function(mDCL, "swcget", dcl_swcget, 1);
rb_define_module_function(mDCL, "swcset", dcl_swcset, 2);
rb_define_module_function(mDCL, "swcstx", dcl_swcstx, 2);
rb_define_module_function(mDCL, "swqfnm", dcl_swqfnm, 1);
rb_define_module_function(mDCL, "swcqnp", dcl_swcqnp, 0);
rb_define_module_function(mDCL, "swcqid", dcl_swcqid, 1);
rb_define_module_function(mDCL, "swcqcp", dcl_swcqcp, 1);
rb_define_module_function(mDCL, "swcqcl", dcl_swcqcl, 1);
rb_define_module_function(mDCL, "swcqvl", dcl_swcqvl, 1);
rb_define_module_function(mDCL, "swcsvl", dcl_swcsvl, 2);
rb_define_module_function(mDCL, "swcqin", dcl_swcqin, 1);
rb_define_module_function(mDCL, "swiget", dcl_swiget, 1);
rb_define_module_function(mDCL, "swiset", dcl_swiset, 2);
rb_define_module_function(mDCL, "swistx", dcl_swistx, 2);
rb_define_module_function(mDCL, "swiqnp", dcl_swiqnp, 0);
rb_define_module_function(mDCL, "swiqid", dcl_swiqid, 1);
rb_define_module_function(mDCL, "swiqcp", dcl_swiqcp, 1);
rb_define_module_function(mDCL, "swiqcl", dcl_swiqcl, 1);
rb_define_module_function(mDCL, "swiqvl", dcl_swiqvl, 1);
rb_define_module_function(mDCL, "swisvl", dcl_swisvl, 2);
rb_define_module_function(mDCL, "swiqin", dcl_swiqin, 1);
rb_define_module_function(mDCL, "swlget", dcl_swlget, 1);
rb_define_module_function(mDCL, "swlset", dcl_swlset, 2);
rb_define_module_function(mDCL, "swlstx", dcl_swlstx, 2);
rb_define_module_function(mDCL, "swlqnp", dcl_swlqnp, 0);
rb_define_module_function(mDCL, "swlqid", dcl_swlqid, 1);
rb_define_module_function(mDCL, "swlqcp", dcl_swlqcp, 1);
rb_define_module_function(mDCL, "swlqcl", dcl_swlqcl, 1);
rb_define_module_function(mDCL, "swlqvl", dcl_swlqvl, 1);
rb_define_module_function(mDCL, "swlsvl", dcl_swlsvl, 2);
rb_define_module_function(mDCL, "swlqin", dcl_swlqin, 1);
rb_define_module_function(mDCL, "swrget", dcl_swrget, 1);
rb_define_module_function(mDCL, "swrset", dcl_swrset, 2);
rb_define_module_function(mDCL, "swrstx", dcl_swrstx, 2);
rb_define_module_function(mDCL, "swrqnp", dcl_swrqnp, 0);
rb_define_module_function(mDCL, "swrqid", dcl_swrqid, 1);
rb_define_module_function(mDCL, "swrqcp", dcl_swrqcp, 1);
rb_define_module_function(mDCL, "swrqcl", dcl_swrqcl, 1);
rb_define_module_function(mDCL, "swrqvl", dcl_swrqvl, 1);
rb_define_module_function(mDCL, "swrsvl", dcl_swrsvl, 2);
rb_define_module_function(mDCL, "swrqin", dcl_swrqin, 1);
#if DCLVER >= 53
rb_define_module_function(mDCL, "swcmll", dcl_swcmll, 0);
#endif
#if DCLVER >= 53
rb_define_module_function(mDCL, "swqcmn", dcl_swqcmn, 0);
#endif
#if DCLVER >= 53
rb_define_module_function(mDCL, "swqcmf", dcl_swqcmf, 1);
#endif
#if DCLVER >= 53
rb_define_module_function(mDCL, "swqcmd", dcl_swqcmd, 1);
#endif
}
syntax highlighted by Code2HTML, v. 0.9.1