LVAL xlc_snd_eqbandvvv(void)
{
sound_type arg1 = getsound(xlgasound());
sound_type arg2 = getsound(xlgasound());
sound_type arg3 = getsound(xlgasound());
sound_type arg4 = getsound(xlgasound());
sound_type result;
xllastarg();
result = snd_eqbandvvv(arg1, arg2, arg3, arg4);
return cvsound(result);
}
LVAL Native_Init()
{
LVAL pXReturn;
int iPort;
TVeosErr iErr;
xlsave1(pXReturn);
if (!moreargs())
iPort = TALK_BOGUS_FD;
else
iPort = getfixnum(xlgafixnum());
xllastarg();
/** invoke veos kernel inialization **/
iErr = Kernel_Init(iPort, Native_MessageToLSpace);
if (iErr == VEOS_SUCCESS) {
/** create a lisp based inspace for messages **/
s_InSpace = xlenter("VEOS_INSPACE");
setvalue(s_InSpace, NIL);
NATIVE_INSPACE = &getvalue(s_InSpace);
/** create keyword symbols for nancy prims **/
k_TestTime = xlenter(":TEST-TIME"); /* use with copy only */
k_Freq = xlenter(":FREQ"); /* use with copy, put or get */
/** setup invariant matcher settings in global param blocks **/
Native_InitMatcherPBs();
/** make a uid return value to signify success **/
Uid2XVect(&IDENT_ADDR, &pXReturn);
}
xlpop();
return(pXReturn);
} /* Native_Init */
/* xcons - construct a new list cell */
LVAL xcons()
{
LVAL carval,cdrval;
/* get the two arguments */
carval = xlgetarg();
cdrval = xlgetarg();
xllastarg();
/* construct a new cons node */
return (cons(carval,cdrval));
}
LVAL Native_Close()
{
if (!KERNEL_INIT)
Native_TrapErr(NATIVE_NOKERNEL, nil);
xllastarg();
Kernel_Shutdown();
return(true);
} /* Native_Close */
/* xterpri - terminate the current print line */
LVAL xterpri(void)
{
LVAL fptr;
/* get file pointer */
fptr = (moreargs() ? xlgetfile() : getvalue(s_stdout));
xllastarg();
/* terminate the print line and return nil */
xlterpri(fptr);
return (NIL);
}
/* xreadline - read a line from a file */
LVAL xreadline(void)
{
unsigned char buf[STRMAX+1],*p,*sptr;
LVAL fptr,str,newstr;
int len,blen,ch;
/* protect some pointers */
xlsave1(str);
/* get file pointer */
fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));
xllastarg();
/* get character and check for eof */
len = blen = 0; p = buf;
while ((ch = xlgetc(fptr)) != EOF && ch != '\n') {
/* check for buffer overflow */
if (blen >= STRMAX) {
newstr = new_string(len + STRMAX + 1);
sptr = getstring(newstr); *sptr = '\0';
if (str) strcat((char *) sptr, (char *) getstring(str));
*p = '\0'; strcat((char *) sptr, (char *) buf);
p = buf; blen = 0;
len += STRMAX;
str = newstr;
}
/* store the character */
*p++ = ch; ++blen;
}
/* check for end of file */
if (len == 0 && p == buf && ch == EOF) {
xlpop();
return (NIL);
}
/* append the last substring */
if (str == NIL || blen) {
newstr = new_string(len + blen + 1);
sptr = getstring(newstr); *sptr = '\0';
if (str) strcat((char *) sptr, (char *) getstring(str));
*p = '\0'; strcat((char *) sptr, (char *) buf);
str = newstr;
}
/* restore the stack */
xlpop();
/* return the string */
return (str);
}
LVAL xlc_snd_flute_freq(void)
{
double arg1 = testarg2(xlgaanynum());
sound_type arg2 = getsound(xlgasound());
sound_type arg3 = getsound(xlgasound());
double arg4 = testarg2(xlgaanynum());
sound_type result;
xllastarg();
result = snd_flute_freq(arg1, arg2, arg3, arg4);
return cvsound(result);
}
LVAL xlc_snd_slider(void)
{
long arg1 = getfixnum(xlgafixnum());
double arg2 = testarg2(xlgaanynum());
double arg3 = testarg2(xlgaanynum());
double arg4 = testarg2(xlgaanynum());
sound_type result;
xllastarg();
result = snd_slider(arg1, arg2, arg3, arg4);
return cvsound(result);
}
/* xmem - xlisp function to print memory statistics */
LVAL xmem(void)
{
/* allow one argument for compatiblity with common lisp */
if (moreargs()) xlgetarg();
xllastarg();
/* print the statistics */
stats();
/* return nil */
return (NIL);
}
LVAL xlc_snd_yin(void)
{
sound_type arg1 = getsound(xlgasound());
double arg2 = testarg2(xlgaanynum());
double arg3 = testarg2(xlgaanynum());
long arg4 = getfixnum(xlgafixnum());
LVAL result;
xllastarg();
result = snd_yin(arg1, arg2, arg3, arg4);
return (result);
}
LVAL xlc_snd_resonvc(void)
{
sound_type arg1 = getsound(xlgasound());
sound_type arg2 = getsound(xlgasound());
double arg3 = testarg2(xlgaanynum());
long arg4 = getfixnum(xlgafixnum());
sound_type result;
xllastarg();
result = snd_resonvc(arg1, arg2, arg3, arg4);
return cvsound(result);
}
LVAL xlc_snd_alpassvv(void)
{
sound_type arg1 = getsound(xlgasound());
sound_type arg2 = getsound(xlgasound());
sound_type arg3 = getsound(xlgasound());
double arg4 = testarg2(xlgaanynum());
sound_type result;
xllastarg();
result = snd_alpassvv(arg1, arg2, arg3, arg4);
return cvsound(result);
}
LVAL xlc_snd_fft(void)
{
sound_type arg1 = getsound(xlgasound());
long arg2 = getfixnum(xlgafixnum());
long arg3 = getfixnum(xlgafixnum());
LVAL arg4 = xlgetarg();
LVAL result;
xllastarg();
result = snd_fft(arg1, arg2, arg3, arg4);
return (result);
}
/* xrdbyte - read a byte from a file */
LVAL xrdbyte(void)
{
LVAL fptr;
int ch;
/* get file pointer */
fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));
xllastarg();
/* get character and check for eof */
return ((ch = xlgetc(fptr)) == EOF ? NIL : cvfixnum((FIXTYPE)ch));
}
LVAL xlc_snd_sine(void)
{
double arg1 = testarg2(xlgaanynum());
double arg2 = testarg2(xlgaanynum());
double arg3 = testarg2(xlgaanynum());
double arg4 = testarg2(xlgaanynum());
sound_type result;
xllastarg();
result = snd_sine(arg1, arg2, arg3, arg4);
return cvsound(result);
}
LVAL xlc_snd_aresonvv(void)
{
sound_type arg1 = getsound(xlgasound());
sound_type arg2 = getsound(xlgasound());
sound_type arg3 = getsound(xlgasound());
long arg4 = getfixnum(xlgafixnum());
sound_type result;
xllastarg();
result = snd_aresonvv(arg1, arg2, arg3, arg4);
return cvsound(result);
}
/* xerror - special form 'error' */
LVAL xerror(void)
{
LVAL emsg,arg;
/* get the error message and the argument */
emsg = xlgastring();
arg = (moreargs() ? xlgetarg() : s_unbound);
xllastarg();
/* signal the error */
xlerror((char *) getstring(emsg),arg);
return NIL; /* won't ever happen */
}
LVAL xsopen_resfile()
{
char *name;
int fn;
name = (char *) getstring(xlgastring());
xllastarg();
CtoPstr(name);
fn = OpenResFile(name);
PtoCstr(name);
return((fn >= 0) ? cvfixnum((FIXTYPE) fn) : NIL);
}
LVAL xlc_snd_ifft(void)
{
double arg1 = testarg2(xlgaanynum());
double arg2 = testarg2(xlgaanynum());
LVAL arg3 = xlgetarg();
long arg4 = getfixnum(xlgafixnum());
LVAL arg5 = xlgetarg();
sound_type result;
xllastarg();
result = snd_ifft(arg1, arg2, arg3, arg4, arg5);
return cvsound(result);
}
LVAL xlc_snd_phasevocoder(void)
{
sound_type arg1 = getsound(xlgasound());
sound_type arg2 = getsound(xlgasound());
long arg3 = getfixnum(xlgafixnum());
long arg4 = getfixnum(xlgafixnum());
long arg5 = getfixnum(xlgafixnum());
sound_type result;
xllastarg();
result = snd_phasevocoder(arg1, arg2, arg3, arg4, arg5);
return cvsound(result);
}
LVAL xlc_snd_stkchorus(void)
{
sound_type arg1 = getsound(xlgasound());
double arg2 = testarg2(xlgaanynum());
double arg3 = testarg2(xlgaanynum());
double arg4 = testarg2(xlgaanynum());
double arg5 = testarg2(xlgaanynum());
sound_type result;
xllastarg();
result = snd_stkchorus(arg1, arg2, arg3, arg4, arg5);
return cvsound(result);
}
/* ARRAY-DATA-ADDRESS array */
LVAL xarraydata_addr()
{
LVAL x = xlgetarg();
xllastarg();
switch (ntype(x)) {
case DARRAY: x = getdarraydata(x); /* and drop through */
case VECTOR:
case STRING:
case TVEC: return newnatptr(gettvecdata(x), x);
default: return xlbadtype(x);
}
}
LVAL xlc_snd_siosc(void)
{
LVAL arg1 = xlgetarg();
double arg2 = testarg2(xlgaanynum());
double arg3 = testarg2(xlgaanynum());
double arg4 = testarg2(xlgaanynum());
sound_type arg5 = getsound(xlgasound());
sound_type result;
xllastarg();
result = snd_siosc(arg1, arg2, arg3, arg4, arg5);
return cvsound(result);
}
LVAL xlc_snd_buzz(void)
{
long arg1 = getfixnum(xlgafixnum());
double arg2 = testarg2(xlgaanynum());
double arg3 = testarg2(xlgaanynum());
double arg4 = testarg2(xlgaanynum());
sound_type arg5 = getsound(xlgasound());
sound_type result;
xllastarg();
result = snd_buzz(arg1, arg2, arg3, arg4, arg5);
return cvsound(result);
}
LVAL xlc_seq_insert_macctrl(void)
{
seq_type arg1 = getseq(xlgaseq());
long arg2 = getfixnum(xlgafixnum());
long arg3 = getfixnum(xlgafixnum());
long arg4 = getfixnum(xlgafixnum());
long arg5 = getfixnum(xlgafixnum());
long arg6 = getfixnum(xlgafixnum());
xllastarg();
insert_macctrl(arg1, arg2, arg3, arg4, arg5, arg6);
return NIL;
}
/* obisa - does an object inherit from class? */
LVAL obisa(void)
{
LVAL self, cl, obcl;
self = xlgaobject();
cl = xlgaobject();
xllastarg();
obcl = getclass(self);
while (obcl) {
if (obcl == cl) return s_true;
obcl = getivar(obcl, SUPERCLASS);
}
return NIL;
}
static NODE *compare(NODE *args, int fcn)
{
NODE *arg1,*arg2;
long icmp;
float fcmp;
int imode;
arg1 = xlarg(&args);
arg2 = xlarg(&args);
xllastarg(args);
if (((arg1) && (arg1)->n_type == 6) && ((arg2) && (arg2)->n_type == 6)) {
icmp = strcmp(((arg1)->n_info.n_xstr.xst_str),((arg2)->n_info.n_xstr.xst_str));
imode = 1;
}
else if (((arg1) && (arg1)->n_type == 5) && ((arg2) && (arg2)->n_type == 5)) {
icmp = ((arg1)->n_info.n_xint.xi_int) - ((arg2)->n_info.n_xint.xi_int);
imode = 1;
}
else if (((arg1) && (arg1)->n_type == 9) && ((arg2) && (arg2)->n_type == 9)) {
fcmp = ((arg1)->n_info.n_xfloat.xf_float) - ((arg2)->n_info.n_xfloat.xf_float);
imode = 0;
}
else if (((arg1) && (arg1)->n_type == 5) && ((arg2) && (arg2)->n_type == 9)) {
fcmp = (float)((arg1)->n_info.n_xint.xi_int) - ((arg2)->n_info.n_xfloat.xf_float);
imode = 0;
}
else if (((arg1) && (arg1)->n_type == 9) && ((arg2) && (arg2)->n_type == 5)) {
fcmp = ((arg1)->n_info.n_xfloat.xf_float) - (float)((arg2)->n_info.n_xint.xi_int);
imode = 0;
}
else
xlfail("expecting strings, integers or floats");
if (imode)
switch (fcn) {
case '<': icmp = (icmp < 0); break;
case 'L': icmp = (icmp <= 0); break;
case '=': icmp = (icmp == 0); break;
case '#': icmp = (icmp != 0); break;
case 'G': icmp = (icmp >= 0); break;
case '>': icmp = (icmp > 0); break;
}
else
switch (fcn) {
case '<': icmp = (fcmp < 0.0); break;
case 'L': icmp = (fcmp <= 0.0); break;
case '=': icmp = (fcmp == 0.0); break;
case '#': icmp = (fcmp != 0.0); break;
case 'G': icmp = (fcmp >= 0.0); break;
case '>': icmp = (fcmp > 0.0); break;
}
return (icmp ? true : (NODE *)0);
}
/* xprofile - turn profiling on and off */
LVAL xprofile()
{
LVAL flag, result;
/* get the argument */
flag = xlgetarg();
xllastarg();
result = (profile_flag ? s_true : NIL);
profile_flag = !null(flag);
/* turn off profiling right away: */
if (!profile_flag) profile_count_ptr = &invisible_counter;
return result;
}
LVAL xsiview_window_update(V)
{
#ifdef MACINTOSH
LVAL object;
int resized;
object = xlgaobject();
resized = (xlgetarg() != NIL);
xllastarg();
graph_update_action(StGWObWinInfo(object), resized);
#endif /* MACINTOSH */
return(NIL);
}
LVAL xlc_snd_mandolin(void)
{
double arg1 = testarg2(xlgaanynum());
double arg2 = testarg2(xlgaanynum());
double arg3 = testarg2(xlgaanynum());
double arg4 = testarg2(xlgaanynum());
double arg5 = testarg2(xlgaanynum());
double arg6 = testarg2(xlgaanynum());
sound_type result;
xllastarg();
result = snd_mandolin(arg1, arg2, arg3, arg4, arg5, arg6);
return cvsound(result);
}
