/**
* CLIPS function that is responsible for calling
* ruby objects
*/
void cl_rcall()
{
int argc = RtnArgCount();
// Sanity check
if(argc < 2) return;
// Get object and method
char *s_obj = RtnLexeme(1);
char *s_mtd = RtnLexeme(2);
// Get variant as I need them
VALUE obj; sscanf(s_obj, "%lx", &obj);
ID mtd = rb_intern(s_mtd);
if(argc == 2)
{
rb_funcall(obj, mtd, 0);
} else {
VALUE argv[argc - 2];
int i;
for(i = 3; i <= argc; i++)
{
DATA_OBJECT argument;
RtnUnknown(i, &argument);
argv[i - 3] = cl_generic_convert_dataobject(argument);
}
rb_funcall2(obj, mtd, argc-2, argv);
}
}
/*eg. (addrunfnc "nrecv_route" "nrecv_route" 1)*/
int addrunfnc()
{
char str[99],fnc[99];
int priority=1,start=0,remove=0,cnt;
cnt= RtnArgCount();
sprintf(str,"%s",(char *)RtnLexeme(1));
sprintf(fnc,"%s",(char *)RtnLexeme(2));
if(cnt>2) priority = (int)RtnLong(3);
if(cnt>3) start = (int)RtnLong(4);
if(cnt>4) remove = (int)RtnLong(5);
if(!remove)
{
/* if(start==1) return(AddRunStartFunction(str,PTIF fnc,priority));*/
/* else if(start==2) return(AddRunStopFunction(str,PTIF fnc,priority));*/
/* else */
/*bad argument 2 type for AddRunFunction(): int (*)() ( void (*)() expected)*/
return(AddRunFunction(str,PTIF2 fnc,priority));
} else
{
/* if(start==1) return(RemoveRunStartFunction(str));*/
/* else if(start==2) return(RemoveRunStopFunction(str));*/
/* else */
return(RemoveRunFunction(str));
}
}
/* DefineFunction2("DF2"",'i',PTIF DF2,"DF2","45iskuss"); */
int
DF2()
{
char c1, chr1[9] ,str1[99] ,str2[99] ,str3[99];
/*PTIF fncptr; at the worst might have to give the return type &do a switch*/
int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/
fncptr = PTIF get_ptr(3);
if((int)fncptr < 999) printf("[fncptr=%d]",(int)fncptr); /*return(0);*/
sprintf(str1,"%s",(char *)RtnLexeme(1));
sprintf(chr1,"%s",(char *)RtnLexeme(2));
sprintf(str2,"%s",(char *)RtnLexeme(4));
c1= chr1[0];
printf("[DefineFunction2 for:%s with type=%c]\n",str1,c1);
if(RtnArgCount()>4)
{
sprintf(str3,"%s",(char *)RtnLexeme(5));
DefineFunction2(str1,c1,PTIF fncptr,str2,str3);
}
else DefineFunction(str1,c1,PTIF fncptr,str2);
return(1);
}
/*DefineFunction2("str-cmp",'i',PTIF str-cmp,"str-cmp","24iss"); */
int str_cmp()
{
int cnt,len=0;
char s1[44],s2[44];
sprintf(s1,"%s",(char *)RtnLexeme(1));
sprintf(s2,"%s",(char *)RtnLexeme(2));
cnt= RtnArgCount();
if(cnt>2)
{
len = (int)RtnLong(3);
if(len>0)
{
if(cnt>3) return(strncasecmp(s1,s2,len));
else return(strncmp(s1,s2,len));
} else
{
if(cnt>3) return(strcasecmp(s1,s2));
else return(strcmp(s1,s2));
}
} else return(strcmp(s1,s2));
} /*there is already a str-compare*/
/*ret: 1st element at the ptr memory location*/
VOID deref(DATA_OBJECT_PTR rp)
{
int n,i,j,*npi,ret=0,t;
float *npf;
char tstr[89],type,*sp;
n = RtnArgCount();
printf("[ac=%d]",n);
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
switch(type)
{
case 'i': npi = (int *)get_ptr(2);
break;
case 'f': npf = (float *)get_ptr(2);
break;
case 'b': sp = (char *)get_ptr(2);
break;
default: printf("bad type %s\n",tstr);
break;
}
if(n > 2) /*then set the values*/
{
for(i=3; i<=n; i++)
{
switch(type)
{
case 'i': printf("[set%d at%d]",(npi[i-3] = get_int(i)),i); break;
case 'f': printf("[set%f at%d]",(npf[i-3] = get_float(i)),i); break;
case 'b': get_str(i,tstr); /*fix-finish*/
t = strlen(tstr);
for(j=0; j<t; j++)
printf("[%c]",(sp[j] = tstr[j]));
break;
}
}
switch(type) /*if setting want ptr, which might be newly malloced*/
{
case 'i' : set_long(rp,(long)npi); break;
case 'f' : set_long(rp,(long)npf); break;
case 'b' : set_long(rp,(long)sp); break;
}
}
else
switch(type)
{
case 'i' : set_int(rp,(int)npi[0]); break;
case 'f' : set_float(rp,(float)npf[0]); break;
case 'b' : printf("[str=%s]",sp);
set_symb(rp,(char *)sp); break;
}
return;
}
/*DefineFunction2("memset",'i',PTIF mem_set,"mem_set","23uuik"); */
int mem_set() /*bzero( a, n )*/
{
int n;
char *a,b='\0',z[9];
a=(char *)get_ptr(1);
n = (int)RtnLong(2);
if(RtnArgCount() >2) {
sprintf(z,"%s",(char *)RtnLexeme(3));
b=z[0];
}
if(!a && !b) {memset(a,b,n); return(0);}
else printf("[memset nil ptr]");
return(1);
}
/*DefineFunction2("typelen",'i',PTIF typelen,"typelen","11kk"); */
int typelen()
{
int r;
char c,type[14];
sprintf(type,"%s",(char *)RtnLexeme(1)); /*type = *RtnLexeme(2);*/
c = type[0];
switch(tolower(c))
{
case 'b' : r = 1; break;
case 'i' : r = sizeof(int); break;
case 'f' : r = sizeof(float); break;
case 'd' : r = sizeof(double); break;
case 'l' : r = sizeof(long); break;
default : r = sizeof(float); break;
}
return(r);
}
/* (DF2 "srrf" i # "srrf" "00i"); */
int tst() {
char str1[99];
sprintf(str1,"%s",(char *)RtnLexeme(1));
printf("[test fnc tst can print out:%s]\n",str1);
return(1);
}
/*-deref or pk_tpn can fill malloced space, then can use this to get to a m.f.*/
VOID tpn_to_mf(DATA_OBJECT_PTR rp)
{
int num=1,stride=1,*pi,offset=0,i;
float *pf;
double *pd;
char tstr[9],type,*pc,t1[2];
VOID *mfp;
t1[1]='\0';
/*get the type*/
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
if(type!='i' && type!='f' && type!='d' && type!='b')
{
printf("[1st arg=type:i or f or d]");
return;
}
/*get number (& offset & stride) to put to a m.f.*/
if(RtnArgCount() > 2) num=(int)RtnLong(3);
if(RtnArgCount() > 3) offset=(int)RtnLong(4);
if(RtnArgCount() > 4) stride=(int)RtnLong(5);
/*could use SetMultifieldErrorValue(rp); return;*/
mfp = CreateMultifield(num);
/*get the ptr, and set the MF*/
switch(type)
{
case 'i' : pi = (int *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,INTEGER);
SetMFValue(mfp,i,AddLong(pi[offset+i]));
}
break;
case 'f' : pf = (float *)get_ptr(2);
for(i=0; i<num; i++)
{
printf("%f to mf,",pf[offset+i]); fflush(stdout);
SetMFType(mfp,i,FLOAT);
SetMFValue(mfp,i,AddDouble((double)pf[offset+i]));
}
break;
case 'd' : pd = (double *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,FLOAT);
SetMFValue(mfp,i,AddDouble(pd[offset+i]));
}
break;
/*this one could go per char or by stride or by space breaks*/
/*go by char for now*/
case 'b' : pc = (char *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,SYMBOL);
t1[0]=pc[offset+i];
SetMFValue(mfp,i,AddSymbol(t1));
}
break;
} /*gets past this and dies when printing out the result-
-looks liked capped ok though*/
SetpType(rp,MULTIFIELD);
SetpValue(rp,mfp);
SetpDOBegin(rp,1);
SetpDOEnd(rp,num);
return;
}
/*return: int version of ptr to the output array*/
int tpppno()
{
int num=1,stride=1,*pi1,*pi2,*piout,offset=0,i,rp=-1;
float *pf1,*pf2,*pfout;
double *pd1,*pd2,*pdout;
char tstr[9],type,t1[2],op;
t1[1]='\0';
/*get the type*/
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
if(type!='i' && type!='f' && type!='d' && type!='b')
{
printf("[1st arg=type:i or f or d]");
return(-1);
}
sprintf(tstr,"%s",(char *)RtnLexeme(6));
op = tolower(tstr[0]);
if(RtnArgCount() > 4) num=(int)RtnLong(5);
switch(type)
{
case 'i' :
pi1 = (int *)get_ptr(2);
pi2 = (int *)get_ptr(3);
piout = (int *)get_ptr(4);
switch(op)
{
case '+': for(i=0; i<num; i++) piout[i] = pi1[i] + pi2[i]; break;
case '-': for(i=0; i<num; i++) piout[i] = pi1[i] - pi2[i]; break;
case '*': for(i=0; i<num; i++) piout[i] = pi1[i] * pi2[i]; break;
case '/': for(i=0; i<num; i++) piout[i] = pi1[i] / pi2[i]; break;
}
rp = (int)piout;
break;
case 'f' :
pf1 = (float *)get_ptr(2);
pf2 = (float *)get_ptr(3);
pfout = (float *)get_ptr(4);
switch(op)
{
case '+': for(i=0; i<num; i++) pfout[i] = pf1[i] + pf2[i]; break;
case '-': for(i=0; i<num; i++) pfout[i] = pf1[i] - pf2[i]; break;
case '*': for(i=0; i<num; i++) pfout[i] = pf1[i] * pf2[i]; break;
case '/': for(i=0; i<num; i++) pfout[i] = pf1[i] / pf2[i]; break;
}
rp = (int)pfout;
break;
case 'd' :
pd1 = (double *)get_ptr(2);
pd2 = (double *)get_ptr(3);
pdout = (double *)get_ptr(4);
switch(op)
{
case '+': for(i=0; i<num; i++) pdout[i] = pd1[i] + pd2[i]; break;
case '-': for(i=0; i<num; i++) pdout[i] = pd1[i] - pd2[i]; break;
case '*': for(i=0; i<num; i++) pdout[i] = pd1[i] * pd2[i]; break;
case '/': for(i=0; i<num; i++) pdout[i] = pd1[i] / pd2[i]; break;
}
rp = (int)pdout;
break;
}
return(rp);
}
/*might be dangerous, maybe trasfer to from mf instead*/
VOID tpn_mf_mirror(DATA_OBJECT_PTR rp)
{
int *pi,i,num,offset=0,stride=1;
float *pf;
double *pd;
char tstr[9],type,t1[2];
VOID *mfp;
t1[1]='\0';
/*get the type*/
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
if(type!='i' && type!='f' && type!='d' && type!='b')
{
printf("[1st arg=type:i or f or d]");
return;
}
/*get number (& offset & stride) to put to a m.f.*/
if(RtnArgCount() > 2) num=(int)RtnLong(3);
if(RtnArgCount() > 3) offset=(int)RtnLong(4);
if(RtnArgCount() > 4) stride=(int)RtnLong(5);
/*could use SetMultifieldErrorValue(rp); return;*/
mfp = CreateMultifield(num);
/*get the ptr, and set the MF*/
switch(type)
{
case 'i' : pi = (int *)get_ptr(2);
for(i=0; i<num; i++)
{
printf(",%d ",
SetMFType(mfp,i,INTEGER));
/*SetMFValue(mfp,i,AddLong(pi[offset+i]));
set the Data_Object ptr to the address*/
}
break;
case 'f' : pf = (float *)get_ptr(2);
for(i=0; i<num; i++)
{
printf("%f to mf,",pf[offset+i]);
fflush(stdout);
printf(",%d ",
SetMFType(mfp,i,FLOAT));
fflush(stdout);
/*SetMFValue(mfp,i,AddDouble((double)pf[offset+i]));
set the Data_Object ptr to the address*/
}
break;
case 'd' : pd = (double *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,FLOAT);
/*SetMFValue(mfp,i,AddDouble(pd[offset+i]));
set the Data_Object ptr to the address*/
}
break;
}
SetpType(rp,MULTIFIELD);
SetpValue(rp,mfp);
SetpDOBegin(rp,1);
SetpDOEnd(rp,num);
return;
}
int gdbm_lookup_p(char *dbm,char *word)
{
GDBM_FILE dbf;
datum key,value;
// int flag;
char abs_db_path[1000];
int len=0,len1=0;
char *dbm1;
DATA_OBJECT temp;
/*=================================*/
/* Check for exactly two argument. */
/*=================================*/
if (ArgCountCheck("gdbm_lookup_p",EXACTLY,2) == -1)
{ return(FALSE); }
/*=================================*/
/* Check the datatype of 2nd argument. */
/*=================================*/
if (ArgTypeCheck("gdbm_lookup_p",2,SYMBOL_OR_STRING,&temp) == 0)
{ return(1L);}
/*==========================================================================================*/
/*RtnLexeme returns a character pointer from either a symbol, string, or instance name data type */
/*=========================================================================================*/
len=(strlen(RtnLexeme(1)));
dbm=malloc(sizeof(char)*len+1);
strcpy(dbm,RtnLexeme(1));
strcpy(abs_db_path,ABS_ANU_PATH);
strcat(abs_db_path,dbm);
free(dbm);
len1=(strlen(abs_db_path));
dbm1=malloc(sizeof(char)*len1+1);
strcpy(dbm1,abs_db_path);
word = RtnLexeme(2);
//PrintRouter(WDISPLAY,"Database: ");PrintRouter(WDISPLAY,RtnLexeme(1));PrintRouter(WDISPLAY," word :");PrintRouter(WDISPLAY,RtnLexeme(2));PrintRouter(WDISPLAY,"\n");
/*=================================*/
/* To open the gdbm file. */
/*=================================*/
dbf = gdbm_open(dbm1,512,GDBM_READER,0644,0);
/*=================================*/
/* Check whether databse is empty. */
/*=================================*/
if (dbf == NULL)
{ PrintRouter(WDISPLAY,"Warning :: Database Not Found ------ OR ----- Database Is Empty.\n");
// PrintRouter(WDISPLAY,"\n");
// PrintRouter(WDISPLAY,RtnLexeme(2));
// PrintRouter(WDISPLAY,"\n");
return(1L); }
key.dptr=word;
key.dsize=strlen(key.dptr);
value = gdbm_fetch(dbf,key);
gdbm_close (dbf);
if(value.dptr!=NULL)
return(TRUE);
else
return(FALSE);
}
/*DefineFunction2("atof",'f',PTIF catof,"catof","11s"); */
float catof()
{
char s1[44];
sprintf(s1,"%s",(char *)RtnLexeme(1));
return(atof(s1));
}
