/* * $Id: p_header,v 1.4 2000/11/27 01:57:01 keiko Exp $ */ #include #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 }