/*
* $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_time12(obj, itime)
VALUE obj, itime;
{
integer i_itime;
integer o_itt;
VALUE itt;
if ((TYPE(itime) != T_BIGNUM) || (TYPE(itime) != T_FIXNUM)) {
itime = rb_funcall(itime, rb_intern("to_i"), 0);
}
i_itime = NUM2INT(itime);
time12_(&i_itime, &o_itt);
itt = INT2NUM(o_itt);
return itt;
}
static VALUE
dcl_time13(obj, itime)
VALUE obj, itime;
{
integer i_itime;
integer o_ih;
integer o_im;
integer o_is;
VALUE ih;
VALUE im;
VALUE is;
if ((TYPE(itime) != T_BIGNUM) || (TYPE(itime) != T_FIXNUM)) {
itime = rb_funcall(itime, rb_intern("to_i"), 0);
}
i_itime = NUM2INT(itime);
time13_(&i_itime, &o_ih, &o_im, &o_is);
ih = INT2NUM(o_ih);
im = INT2NUM(o_im);
is = INT2NUM(o_is);
return rb_ary_new3(3, ih, im, is);
}
static VALUE
dcl_time21(obj, itt)
VALUE obj, itt;
{
integer o_itime;
integer i_itt;
VALUE itime;
if ((TYPE(itt) != T_BIGNUM) || (TYPE(itt) != T_FIXNUM)) {
itt = rb_funcall(itt, rb_intern("to_i"), 0);
}
i_itt = NUM2INT(itt);
time21_(&o_itime, &i_itt);
itime = INT2NUM(o_itime);
return itime;
}
static VALUE
dcl_time23(obj, itt)
VALUE obj, itt;
{
integer o_ih;
integer o_im;
integer o_is;
integer i_itt;
VALUE ih;
VALUE im;
VALUE is;
if ((TYPE(itt) != T_BIGNUM) || (TYPE(itt) != T_FIXNUM)) {
itt = rb_funcall(itt, rb_intern("to_i"), 0);
}
i_itt = NUM2INT(itt);
time23_(&o_ih, &o_im, &o_is, &i_itt);
ih = INT2NUM(o_ih);
im = INT2NUM(o_im);
is = INT2NUM(o_is);
return rb_ary_new3(3, ih, im, is);
}
static VALUE
dcl_time31(obj, ih, im, is)
VALUE obj, ih, im, is;
{
integer o_itime;
integer i_ih;
integer i_im;
integer i_is;
VALUE itime;
if ((TYPE(ih) != T_BIGNUM) || (TYPE(ih) != T_FIXNUM)) {
ih = rb_funcall(ih, rb_intern("to_i"), 0);
}
if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) {
im = rb_funcall(im, rb_intern("to_i"), 0);
}
if ((TYPE(is) != T_BIGNUM) || (TYPE(is) != T_FIXNUM)) {
is = rb_funcall(is, rb_intern("to_i"), 0);
}
i_ih = NUM2INT(ih);
i_im = NUM2INT(im);
i_is = NUM2INT(is);
time31_(&o_itime, &i_ih, &i_im, &i_is);
itime = INT2NUM(o_itime);
return itime;
}
static VALUE
dcl_time32(obj, ih, im, is)
VALUE obj, ih, im, is;
{
integer i_ih;
integer i_im;
integer i_is;
integer o_itt;
VALUE itt;
if ((TYPE(ih) != T_BIGNUM) || (TYPE(ih) != T_FIXNUM)) {
ih = rb_funcall(ih, rb_intern("to_i"), 0);
}
if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) {
im = rb_funcall(im, rb_intern("to_i"), 0);
}
if ((TYPE(is) != T_BIGNUM) || (TYPE(is) != T_FIXNUM)) {
is = rb_funcall(is, rb_intern("to_i"), 0);
}
i_ih = NUM2INT(ih);
i_im = NUM2INT(im);
i_is = NUM2INT(is);
time32_(&i_ih, &i_im, &i_is, &o_itt);
itt = INT2NUM(o_itt);
return itt;
}
static VALUE
dcl_timec1(obj, cform, itime)
VALUE obj, cform, itime;
{
char *io_cform;
integer i_itime;
if (TYPE(cform) != T_STRING) {
cform = rb_funcall(cform, rb_intern("to_str"), 0);
}
if ((TYPE(itime) != T_BIGNUM) || (TYPE(itime) != T_FIXNUM)) {
itime = rb_funcall(itime, rb_intern("to_i"), 0);
}
io_cform = ALLOCA_N(char, strlen(STR2CSTR(cform))+1);
strcpy(io_cform, STR2CSTR(cform));
i_itime = NUM2INT(itime);
timec1_(io_cform, &i_itime, (ftnlen)strlen(io_cform));
cform = rb_str_new2(io_cform);
return cform;
}
static VALUE
dcl_timec2(obj, cform, itt)
VALUE obj, cform, itt;
{
char *io_cform;
integer i_itt;
if (TYPE(cform) != T_STRING) {
cform = rb_funcall(cform, rb_intern("to_str"), 0);
}
if ((TYPE(itt) != T_BIGNUM) || (TYPE(itt) != T_FIXNUM)) {
itt = rb_funcall(itt, rb_intern("to_i"), 0);
}
io_cform = ALLOCA_N(char, strlen(STR2CSTR(cform))+1);
strcpy(io_cform, STR2CSTR(cform));
i_itt = NUM2INT(itt);
timec2_(io_cform, &i_itt, (ftnlen)strlen(io_cform));
cform = rb_str_new2(io_cform);
return cform;
}
static VALUE
dcl_timec3(obj, cform, ih, im, is)
VALUE obj, cform, ih, im, is;
{
char *io_cform;
integer i_ih;
integer i_im;
integer i_is;
if (TYPE(cform) != T_STRING) {
cform = rb_funcall(cform, rb_intern("to_str"), 0);
}
if ((TYPE(ih) != T_BIGNUM) || (TYPE(ih) != T_FIXNUM)) {
ih = rb_funcall(ih, rb_intern("to_i"), 0);
}
if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) {
im = rb_funcall(im, rb_intern("to_i"), 0);
}
if ((TYPE(is) != T_BIGNUM) || (TYPE(is) != T_FIXNUM)) {
is = rb_funcall(is, rb_intern("to_i"), 0);
}
io_cform = ALLOCA_N(char, strlen(STR2CSTR(cform))+1);
strcpy(io_cform, STR2CSTR(cform));
i_ih = NUM2INT(ih);
i_im = NUM2INT(im);
i_is = NUM2INT(is);
timec3_(io_cform, &i_ih, &i_im, &i_is, (ftnlen)strlen(io_cform));
cform = rb_str_new2(io_cform);
return cform;
}
static VALUE
dcl_timeq1(obj)
VALUE obj;
{
integer o_itime;
VALUE itime;
timeq1_(&o_itime);
itime = INT2NUM(o_itime);
return itime;
}
static VALUE
dcl_timeq2(obj)
VALUE obj;
{
integer o_itt;
VALUE itt;
timeq2_(&o_itt);
itt = INT2NUM(o_itt);
return itt;
}
void
init_misc1_timelib(mDCL)
VALUE mDCL;
{
rb_define_module_function(mDCL, "time12", dcl_time12, 1);
rb_define_module_function(mDCL, "time13", dcl_time13, 1);
rb_define_module_function(mDCL, "time21", dcl_time21, 1);
rb_define_module_function(mDCL, "time23", dcl_time23, 1);
rb_define_module_function(mDCL, "time31", dcl_time31, 3);
rb_define_module_function(mDCL, "time32", dcl_time32, 3);
rb_define_module_function(mDCL, "timec1", dcl_timec1, 2);
rb_define_module_function(mDCL, "timec2", dcl_timec2, 2);
rb_define_module_function(mDCL, "timec3", dcl_timec3, 4);
rb_define_module_function(mDCL, "timeq1", dcl_timeq1, 0);
rb_define_module_function(mDCL, "timeq2", dcl_timeq2, 0);
}
syntax highlighted by Code2HTML, v. 0.9.1