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); }