/* xlrinit - initialize the reader */
void xlrinit(void)
{
LVAL rtable;
char *p;
int ch;
/* create the read table */
rtable = newvector(256);
setvalue(s_rtable,rtable);
/* initialize the readtable */
for (p = WSPACE; ch = *p++; )
setelement(rtable,ch,k_wspace);
for (p = CONST1; ch = *p++; )
setelement(rtable,ch,k_const);
for (p = CONST2; ch = *p++; )
setelement(rtable,ch,k_const);
/* setup the escape characters */
setelement(rtable,'\\',k_sescape);
setelement(rtable,'|', k_mescape);
/* install the read macros */
defmacro('#', k_nmacro,FT_RMHASH);
defmacro('\'',k_tmacro,FT_RMQUOTE);
defmacro('"', k_tmacro,FT_RMDQUOTE);
defmacro('`', k_tmacro,FT_RMBQUOTE);
defmacro(',', k_tmacro,FT_RMCOMMA);
defmacro('(', k_tmacro,FT_RMLPAR);
defmacro(')', k_tmacro,FT_RMRPAR);
defmacro(';', k_tmacro,FT_RMSEMI);
}
LUA_API void luaS_setColor(lua_State *L, int p, float x, float y, float z, float w) {
p=lua_absindex(L,p);
setelement(L, p, x, "r");
setelement(L, p, y, "g");
setelement(L, p, z, "b");
setelement(L, p, w, "a");
}
/* xlenter - enter a symbol into the obarray */
NODE *xlenter(char *name,int type)
{
NODE ***oldstk,*sym __HEAPIFY,*array;
int i;
/* check for nil */
if (strcmp(name,"NIL") == 0)
return (NIL);
/* check for symbol already in table */
array = getvalue(obarray);
i = hash(name,HSIZE);
for (sym = getelement(array,i); sym; sym = cdr(sym))
if (strcmp(name,getstring(getpname(car(sym)))) == 0)
return (car(sym));
/* make a new symbol node and link it into the list */
oldstk = xlsave1(&sym);
sym = consd(getelement(array,i));
rplaca(sym,xlmakesym(name,type));
setelement(array,i,sym);
xlstack = oldstk;
/* return the new symbol */
return (car(sym));
}
/* xlobsetvalue - set the value of an instance variable */
int xlobsetvalue(LVAL pair, LVAL sym, LVAL val)
{
LVAL cls,names;
int ivtotal,n;
/* find the instance or class variable */
for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
/* check the instance variables */
names = getivar(cls,IVARS);
ivtotal = getivcnt(cls,IVARTOTAL);
for (n = ivtotal - getivcnt(cls,IVARCNT); n < ivtotal; ++n) {
if (car(names) == sym) {
setivar(car(pair),n,val);
return (TRUE);
}
names = cdr(names);
}
/* check the class variables */
names = getivar(cls,CVARS);
for (n = 0; consp(names); ++n) {
if (car(names) == sym) {
setelement(getivar(cls,CVALS),n,val);
return (TRUE);
}
names = cdr(names);
}
}
/* variable not found */
return (FALSE);
}
/* defmacro - define a read macro */
void defmacro(int ch, LVAL type, int offset)
{
extern FUNDEF funtab[];
LVAL subr;
subr = cvsubr(funtab[offset].fd_subr,funtab[offset].fd_type,offset);
setelement(getvalue(s_rtable),ch,cons(type,subr));
}
/* xlenter - enter a symbol into the obarray */
LVAL xlenter(char *name)
{
LVAL sym,array;
int i;
/* check for nil */
if (strcmp(name,"NIL") == 0)
return (NIL);
/* check for symbol already in table */
array = getvalue(obarray);
i = hash(name,HSIZE);
for (sym = getelement(array,i); sym; sym = cdr(sym))
if (strcmp(name,(char *) getstring(getpname(car(sym)))) == 0)
return (car(sym));
/* make a new symbol node and link it into the list */
xlsave1(sym);
sym = consd(getelement(array,i));
rplaca(sym,xlmakesym(name));
setelement(array,i,sym);
xlpop();
/* return the new symbol */
return (car(sym));
}
/* newobject - allocate and initialize a new object */
NODE *newobject(NODE *cls, int size)
{
NODE *val;
val = newvector(size+1);
setelement(val,0,cls);
val->n_type = OBJ;
return (val);
}
/* newobject - allocate and initialize a new object */
LVAL newobject(LVAL cls, int size)
{
LVAL val;
val = newvector(size+1);
val->n_type = OBJECT;
setelement(val,0,cls);
return (val);
}
// Restore the symbol values to their original value and remove any added
// symbols.
LOCAL void nyx_restore_obarray()
{
LVAL obvec = getvalue(obarray);
int i;
// Scan all obarray vectors
for (i = 0; i < HSIZE; i++) {
LVAL last = NULL;
LVAL dcon;
// Scan all elements
for (dcon = getelement(obvec, i); dcon; dcon = cdr(dcon)) {
LVAL dsym = car(dcon);
char *name = (char *)getstring(getpname(dsym));
LVAL scon;
// Ignore *OBARRAY* since setting it causes the input array to be
// truncated.
if (strcmp(name, "*OBARRAY*") == 0) {
continue;
}
// Ignore *SCRATCH* since it's allowed to be updated
if (strcmp(name, "*SCRATCH*") == 0) {
continue;
}
// Find the symbol in the original obarray.
for (scon = getelement(nyx_obarray, hash(name, HSIZE)); scon; scon = cdr(scon)) {
LVAL ssym = car(scon);
// If found, then set the current symbols value to the original.
if (strcmp(name, (char *)getstring(getpname(ssym))) == 0) {
setvalue(dsym, nyx_dup_value(getvalue(ssym)));
setplist(dsym, nyx_dup_value(getplist(ssym)));
setfunction(dsym, nyx_dup_value(getfunction(ssym)));
break;
}
}
// If we didn't find the symbol in the original obarray, then it must've
// been added and must be removed from the current obarray.
if (scon == NULL) {
if (last) {
rplacd(last, cdr(dcon));
}
else {
setelement(obvec, i, cdr(dcon));
}
}
// Must track the last dcon for symbol removal
last = dcon;
}
}
}
LVAL snd_make_yin(sound_type s, double low_step, double high_step, long stepsize)
{
LVAL result;
int j;
register yin_susp_type susp;
rate_type sr = s->sr;
time_type t0 = s->t0;
falloc_generic(susp, yin_susp_node, "snd_make_yin");
susp->susp.fetch = yin_fetch;
susp->terminate_cnt = UNKNOWN;
/* initialize susp state */
susp->susp.free = yin_free;
susp->susp.sr = sr / stepsize;
susp->susp.t0 = t0;
susp->susp.mark = yin_mark;
susp->susp.print_tree = yin_print_tree;
susp->susp.name = "yin";
susp->logically_stopped = false;
susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s);
susp->susp.current = 0;
susp->s = s;
susp->s_cnt = 0;
susp->m = (long) (sr / step_to_hz(high_step));
if (susp->m < 2) susp->m = 2;
/* add 1 to make sure we round up */
susp->middle = (long) (sr / step_to_hz(low_step)) + 1;
susp->blocksize = susp->middle * 2;
susp->stepsize = stepsize;
/* blocksize must be at least step size to implement stepping */
if (susp->stepsize > susp->blocksize) susp->blocksize = susp->stepsize;
susp->block = (sample_type *) malloc(susp->blocksize * sizeof(sample_type));
susp->temp = (float *) malloc((susp->middle - susp->m + 1) * sizeof(float));
susp->fillptr = susp->block;
susp->endptr = susp->block + susp->blocksize;
xlsave1(result);
result = newvector(2); /* create array for F0 and harmonicity */
/* create sounds to return */
for (j = 0; j < 2; j++) {
sound_type snd = sound_create((snd_susp_type)susp,
susp->susp.t0, susp->susp.sr, 1.0);
LVAL snd_lval = cvsound(snd);
/* nyquist_printf("yin_create: sound %d is %x, LVAL %x\n", j, snd, snd_lval); */
setelement(result, j, snd_lval);
susp->chan[j] = snd->list;
/* DEBUG: ysnd[j] = snd; */
}
xlpop();
return result;
}
void nyx_set_input_audio(nyx_audio_callback callback,
void *userdata,
int num_channels,
long len, double rate)
{
LVAL val;
int ch;
nyx_set_audio_params(rate, len);
if (num_channels > 1) {
val = newvector(num_channels);
}
xlprot1(val);
for (ch = 0; ch < num_channels; ch++) {
nyx_susp_type susp;
sound_type snd;
falloc_generic(susp, nyx_susp_node, "nyx_set_input_audio");
susp->callback = callback;
susp->userdata = userdata;
susp->len = len;
susp->channel = ch;
susp->susp.fetch = nyx_susp_fetch;
susp->susp.keep_fetch = NULL;
susp->susp.free = nyx_susp_free;
susp->susp.mark = NULL;
susp->susp.print_tree = nyx_susp_print_tree;
susp->susp.name = "nyx";
susp->susp.toss_cnt = 0;
susp->susp.current = 0;
susp->susp.sr = rate;
susp->susp.t0 = 0.0;
susp->susp.log_stop_cnt = 0;
snd = sound_create((snd_susp_type) susp, 0.0, rate, 1.0);
if (num_channels > 1) {
setelement(val, ch, cvsound(snd));
}
else {
val = cvsound(snd);
}
}
setvalue(xlenter("S"), val);
xlpop();
}
/* xlsinit - symbol initialization routine */
void xlsinit(void)
{
LVAL array,p;
/* initialize the obarray */
obarray = xlmakesym("*OBARRAY*");
array = newvector(HSIZE);
setvalue(obarray,array);
/* add the symbol *OBARRAY* to the obarray */
p = consa(obarray);
setelement(array,hash("*OBARRAY*",HSIZE),p);
}
/* pvector - parse a vector */
LOCAL LVAL pvector(LVAL fptr)
{
LVAL list,expr,val,lastnptr,nptr;
int len,ch,i;
/* protect some pointers */
xlstkcheck(2);
xlsave(list);
xlsave(expr);
/* keep appending nodes until a closing paren is found */
for (lastnptr = NIL, len = 0; (ch = nextch(fptr)) != ')'; ) {
/* check for end of file */
if (ch == EOF)
badeof(fptr);
/* get the next expression */
switch (readone(fptr,&expr)) {
case EOF:
badeof(fptr);
case TRUE:
nptr = consa(expr);
if (lastnptr == NIL)
list = nptr;
else
rplacd(lastnptr,nptr);
lastnptr = nptr;
len++;
break;
}
}
/* skip the closing paren */
xlgetc(fptr);
/* make a vector of the appropriate length */
val = newvector(len);
/* copy the list into the vector */
for (i = 0; i < len; ++i, list = cdr(list))
setelement(val,i,car(list));
/* restore the stack */
xlpopn(2);
/* return successfully */
return (val);
}
/* Make a copy of the obarray so that we can erase any
changes the user makes to global variables */
LOCAL void nyx_copy_obarray()
{
LVAL newarray;
int i;
// Create and set the new vector.
newarray = newvector(HSIZE);
setvalue(obarray, newarray);
for (i = 0; i < HSIZE; i++) {
LVAL from = getelement(nyx_obarray, i);
if (from) {
setelement(newarray, i, copylist(from));
}
}
}
/* xvector - make a vector */
LVAL xvector(void)
{
LVAL val;
int i;
/* make the vector */
val = newvector(xlargc);
/* store each argument */
for (i = 0; moreargs(); ++i)
setelement(val,i,nextarg());
xllastarg();
/* return the vector */
return (val);
}
/* xlsinit - symbol initialization routine */
void xlsinit(void)
{
NODE *array,*p;
/* initialize the obarray */
obarray = xlmakesym("*OBARRAY*",STATIC);
array = newvector(HSIZE);
setvalue(obarray,array);
/* add the symbol *OBARRAY* to the obarray */
p = consa(obarray);
setelement(array,hash("*OBARRAY*",HSIZE),p);
/* enter the unbound symbol indicator */
s_unbound = xlsenter("*UNBOUND*");
setvalue(s_unbound,s_unbound);
}
/* Make a copy of the obarray so that we can erase any
changes the user makes to global variables */
void nyx_save_obarray()
{
LVAL array, obarrayvec;
int i;
xlsave1(array);
array = newvector(HSIZE);
obarrayvec = getvalue(obarray);
for(i=0; i<HSIZE; i++) {
LVAL from = getelement(obarrayvec, i);
if (from)
setelement(array, i, copylist(from));
}
nyx_old_obarray = obarray;
obarray = xlmakesym("*OBARRAY*");
setvalue(obarray, array);
xlpop();
}
// Copy a node (recursively if appropriate)
LOCAL LVAL nyx_dup_value(LVAL val)
{
LVAL nval = val;
// Protect old and new values
xlprot1(val);
xlprot1(nval);
// Copy the node
if (val != NIL) {
switch (ntype(val))
{
case FIXNUM:
nval = cvfixnum(getfixnum(val));
break;
case FLONUM:
nval = cvflonum(getflonum(val));
break;
case CHAR:
nval = cvchar(getchcode(val));
break;
case STRING:
nval = cvstring((char *) getstring(val));
break;
case VECTOR:
{
int len = getsize(val);
int i;
nval = newvector(len);
nval->n_type = ntype(val);
for (i = 0; i < len; i++) {
if (getelement(val, i) == val) {
setelement(nval, i, val);
}
else {
setelement(nval, i, nyx_dup_value(getelement(val, i)));
}
}
}
break;
case CONS:
nval = nyx_dup_value(cdr(val));
nval = cons(nyx_dup_value(car(val)), nval);
break;
case SUBR:
case FSUBR:
nval = cvsubr(getsubr(val), ntype(val), getoffset(val));
break;
// Symbols should never be copied since their addresses are cached
// all over the place.
case SYMBOL:
nval = val;
break;
// Streams are not copied (although USTREAM could be) and reference
// the original value.
case USTREAM:
case STREAM:
nval = val;
break;
// Externals aren't copied because I'm not entirely certain they can be.
case EXTERN:
nval = val;
break;
// For all other types, just allow them to reference the original
// value. Probably not the right thing to do, but easier.
case OBJECT:
case CLOSURE:
default:
nval = val;
break;
}
}
xlpop();
xlpop();
return nval;
}
sample_type sound_save_array(LVAL sa, long n, snd_type snd,
char *buf, long *ntotal, snd_type player)
{
long i, chans;
long buflen;
sound_state_type state;
double start_time = HUGE_VAL;
float *float_bufp;
LVAL sa_copy;
long debug_unit; /* print messages at intervals of this many samples */
long debug_count; /* next point at which to print a message */
sample_type max_sample = 0.0F;
cvtfn_type cvtfn;
*ntotal = 0;
/* THE ALGORITHM: first merge floating point samples from N channels
* into consecutive multi-channel frames in buf. Then, treat buf
* as just one channel and use one of the cvt_to_* functions to
* convert the data IN PLACE in the buffer (this is ok because the
* converted data will never take more space than the original 32-bit
* floats, so the converted data will not overwrite any floats before
* the floats are converted
*/
/* if snd_expr was simply a symbol, then sa now points to
a shared sound_node. If we read samples from it, then
the sounds bound to the symbol will be destroyed, so
copy it first. If snd_expr was a real expression that
computed a new value, then the next garbage collection
will reclaim the sound array. See also sound_save_sound()
*/
chans = getsize(sa);
if (chans > MAX_SND_CHANNELS) {
xlerror("sound_save: too many channels", sa);
free(buf);
snd_close(snd);
}
xlprot1(sa);
sa_copy = newvector(chans);
xlprot1(sa_copy);
/* Why do we copy the array into an xlisp array instead of just
* the state[i] array? Because some of these sounds may reference
* the lisp heap. We must put the sounds in an xlisp array so that
* the gc will find and mark them. xlprot1(sa_copy) makes the array
* visible to gc.
*/
for (i = 0; i < chans; i++) {
sound_type s = getsound(getelement(sa, i));
setelement(sa_copy, i, cvsound(sound_copy(s)));
}
sa = sa_copy; /* destroy original reference to allow GC */
state = (sound_state_type) malloc(sizeof(sound_state_node) * chans);
for (i = 0; i < chans; i++) {
state[i].sound = getsound(getelement(sa, i));
state[i].scale = state[i].sound->scale;
D nyquist_printf("save scale factor %d = %g\n", (int)i, state[i].scale);
state[i].terminated = false;
state[i].cnt = 0; /* force a fetch */
start_time = min(start_time, state[i].sound->t0);
}
for (i = 0; i < chans; i++) {
if (state[i].sound->t0 > start_time)
sound_prepend_zeros(state[i].sound, start_time);
}
/* for debugging */
/* printing_this_sound = s;*/
cvtfn = find_cvt_to_fn(snd, buf);
#ifdef MACINTOSH
if (player) {
gprintf(TRANS, "Playing audio: Click and hold mouse button to stop playback.\n");
}
#endif
debug_unit = debug_count = (long) max(snd->format.srate, 10000.0);
while (n > 0) {
/* keep the following information for each sound:
has it terminated?
pointer to samples
number of samples remaining in block
scan to find the minimum remaining samples and
output that many in an inner loop. Stop outer
loop if all sounds have terminated
*/
int terminated = true;
int togo = n;
int j;
float peak;
oscheck();
for (i = 0; i < chans; i++) {
if (state[i].cnt == 0) {
if (sndwrite_trace) {
nyquist_printf("CALLING SOUND_GET_NEXT "
"ON CHANNEL %d (%p)\n",
(int)i, state[i].sound);
sound_print_tree(state[i].sound);
}
state[i].ptr = sound_get_next(state[i].sound,
&(state[i].cnt))->samples;
if (sndwrite_trace) {
nyquist_printf("RETURNED FROM CALL TO SOUND_GET_NEXT "
"ON CHANNEL %d\n", (int)i);
}
if (state[i].ptr == zero_block->samples) {
state[i].terminated = true;
}
}
if (!state[i].terminated) terminated = false;
togo = min(togo, state[i].cnt);
}
if (terminated) break;
float_bufp = (float *) buf;
for (j = 0; j < togo; j++) {
for (i = 0; i < chans; i++) {
double s = *(state[i].ptr++) * state[i].scale;
*float_bufp++ = (float) s;
}
}
// we're treating sound as mono for the conversion, so multiply
// togo by chans to get proper number of samples, and divide by
// chans to convert back to frame count required by snd_write
buflen = (*cvtfn)((void *) buf, (void *) buf, togo * chans, 1.0F,
&peak) / chans;
if (peak > max_sample) max_sample = peak;
#ifdef MACINTOSH
if (Button()) {
if (player) {
snd_reset(player);
}
gprintf(TRANS, "\n\nStopping playback...\n\n\n");
break;
}
#endif
if (snd->u.file.file != -1) snd_write(snd, (void *) buf, buflen);
if (player) write_to_audio(player, (void *) buf, buflen);
n -= togo;
for (i = 0; i < chans; i++) {
state[i].cnt -= togo;
}
*ntotal += togo;
if (*ntotal > debug_count) {
gprintf(TRANS, " %d ", *ntotal);
fflush(stdout);
debug_count += debug_unit;
}
}
gprintf(TRANS, "total samples: %d x %d channels\n",
*ntotal, chans);
/* references to sounds are shared by sa_copy and state[].
* here, we dispose of state[], allowing GC to do the
* sound_unref call that frees the sounds. (Freeing them now
* would be a bug.)
*/
free(state);
xlpop();
return max_sample;
}
void nyx_set_input_audio(nyx_audio_callback callback,
void *userdata,
int num_channels,
long len, double rate)
{
sample_type scale_factor = 1.0;
time_type t0 = 0.0;
nyx_susp_type *susp;
sound_type *snd;
double stretch_len;
LVAL warp;
int ch;
susp = (nyx_susp_type *)malloc(num_channels * sizeof(nyx_susp_type));
snd = (sound_type *)malloc(num_channels * sizeof(sound_type));
for(ch=0; ch < num_channels; ch++) {
falloc_generic(susp[ch], nyx_susp_node, "nyx_set_input_audio");
susp[ch]->callback = callback;
susp[ch]->userdata = userdata;
susp[ch]->len = len;
susp[ch]->channel = ch;
susp[ch]->susp.sr = rate;
susp[ch]->susp.t0 = t0;
susp[ch]->susp.mark = NULL;
susp[ch]->susp.print_tree = nyx_susp_print_tree;
susp[ch]->susp.current = 0;
susp[ch]->susp.fetch = nyx_susp_fetch;
susp[ch]->susp.free = nyx_susp_free;
susp[ch]->susp.name = "nyx";
snd[ch] = sound_create((snd_susp_type)susp[ch], t0,
rate,
scale_factor);
}
/* Bind the sample rate to the "*sound-srate*" global */
setvalue(xlenter("*SOUND-SRATE*"), cvflonum(rate));
/* Bind selection len to "len" global */
setvalue(xlenter("LEN"), cvflonum(len));
if (len > 0)
stretch_len = len / rate;
else
stretch_len = 1.0;
/* Set the "*warp*" global based on the length of the audio */
xlprot1(warp);
warp = cons(cvflonum(0), /* time offset */
cons(cvflonum(stretch_len), /* time stretch */
cons(NULL, /* cont. time warp */
NULL)));
setvalue(xlenter("*WARP*"), warp);
xlpop();
if (num_channels > 1) {
LVAL array = newvector(num_channels);
for(ch=0; ch<num_channels; ch++)
setelement(array, ch, cvsound(snd[ch]));
setvalue(xlenter("S"), array);
}
else {
LVAL s = cvsound(snd[0]);
setvalue(xlenter("S"), s);
}
}
LVAL snd_fft(sound_type s, long len, long step, LVAL winval)
{
long i, maxlen, skip, fillptr;
float *samples;
float *temp_fft;
float *window;
LVAL result;
if (len < 1) xlfail("len < 1");
if (!s->extra) { /* this is the first call, so fix up s */
sound_type w = NULL;
if (winval) {
if (soundp(winval)) {
w = getsound(winval);
} else {
xlerror("expected a sound", winval);
}
}
/* note: any storage required by fft must be allocated here in a
* contiguous block of memory who's size is given by the first long
* in the block. Here, there are 4 more longs after the size, and
* then room for 4*len floats (assumes that floats and longs take
* equal space).
*
* The reason for 4*len floats is to provide space for:
* the samples to be transformed (len)
* the complex FFT result (2*len)
* the window coefficients (len)
*
* The reason for this storage restriction is that when a sound is
* freed, the block of memory pointed to by extra is also freed.
* There is no function call that might free a more complex
* structure (this could be added in sound.c, however, if it's
* really necessary).
*/
s->extra = (long *) malloc(sizeof(long) * (4 * len + OFFSET));
s->extra[0] = sizeof(long) * (4 * len + OFFSET);
s->CNT = s->INDEX = s->FILLCNT = 0;
s->TERMCNT = -1;
maxlen = len;
window = (float *) &(s->extra[OFFSET + 3 * len]);
/* fill the window from w */
if (!w) {
for (i = 0; i < len; i++) *window++ = 1.0F;
} else {
n_samples_from_sound(w, len, window);
}
} else {
maxlen = ((s->extra[0] / sizeof(long)) - OFFSET) / 4;
if (maxlen != len) xlfail("len changed from initial value");
}
samples = (float *) &(s->extra[OFFSET]);
temp_fft = samples + len;
window = temp_fft + 2 * len;
/* step 1: refill buffer with samples */
fillptr = s->FILLCNT;
while (fillptr < maxlen) {
if (s->INDEX == s->CNT) {
sound_get_next(s, &(s->CNT));
if (s->SAMPLES == zero_block->samples) {
if (s->TERMCNT < 0) s->TERMCNT = fillptr;
}
s->INDEX = 0;
}
samples[fillptr++] = s->SAMPLES[s->INDEX++] * s->scale;
}
s->FILLCNT = fillptr;
/* it is important to test here AFTER filling the buffer, because
* if fillptr WAS 0 when we hit the zero_block, then filling the
* buffer will set TERMCNT to 0.
*/
if (s->TERMCNT == 0) return NULL;
/* logical stop time is ignored by this code -- to fix this,
* you would need a way to return the logical stop time to
* the caller.
*/
/* step 2: construct an array and return it */
xlsave1(result);
result = newvector(len);
/* first len floats will be real part, second len floats imaginary
* copy buffer to temp_fft with windowing
*/
for (i = 0; i < len; i++) {
temp_fft[i] = samples[i] * *window++;
temp_fft[i + len] = 0.0F;
}
/* perform the fft: */
fftnf(1, (const int *) &len, temp_fft, temp_fft + len, 1, -1.0);
setelement(result, 0, cvflonum(temp_fft[0]));
for (i = 2; i < len; i += 2) {
setelement(result, i - 1, cvflonum(temp_fft[i / 2] * 2));
setelement(result, i, cvflonum(temp_fft[len + (i / 2)] * -2));
}
if (len % 2 == 0)
setelement(result, len - 1, cvflonum(temp_fft[len / 2]));
/* step 3: shift samples by step */
if (step < 0) xlfail("step < 0");
s->FILLCNT -= step;
if (s->FILLCNT < 0) s->FILLCNT = 0;
for (i = 0; i < s->FILLCNT; i++) {
samples[i] = samples[i + step];
}
if (s->TERMCNT >= 0) {
s->TERMCNT -= step;
if (s->TERMCNT < 0) s->TERMCNT = 0;
}
/* step 4: advance in sound to next sample we need
* (only does work if step > size of buffer)
*/
skip = step - maxlen;
while (skip > 0) {
long remaining = s->CNT - s->INDEX;
if (remaining >= skip) {
s->INDEX += skip;
skip = 0;
} else {
skip -= remaining;
sound_get_next(s, &(s->CNT));
s->INDEX = 0;
}
}
/* restore the stack */
xlpop();
return result;
} /* snd_fetch_array */
LUA_API void luaS_setData(lua_State *L, int p, float x, float y, float z, float w) {
setelement(L, p, x, "x");
setelement(L, p, y, "y");
setelement(L, p, z, "z");
setelement(L, p, w, "w");
}
sample_type sound_save_array(LVAL sa, long n, SF_INFO *sf_info,
SNDFILE *sndfile, float *buf, long *ntotal, PaStream *audio_stream)
{
long i, chans;
float *float_bufp;
sound_state_type state;
double start_time = HUGE_VAL;
LVAL sa_copy;
long debug_unit; /* print messages at intervals of this many samples */
long debug_count; /* next point at which to print a message */
sample_type max_sample = 0.0F;
sample_type threshold = 0.0F;
/* cvtfn_type cvtfn; jlh */
*ntotal = 0;
/* THE ALGORITHM: first merge floating point samples from N channels
* into consecutive multi-channel frames in buf. Then, treat buf
* as just one channel and use one of the cvt_to_* functions to
* convert the data IN PLACE in the buffer (this is ok because the
* converted data will never take more space than the original 32-bit
* floats, so the converted data will not overwrite any floats before
* the floats are converted
*/
/* if snd_expr was simply a symbol, then sa now points to
a shared sound_node. If we read samples from it, then
the sounds bound to the symbol will be destroyed, so
copy it first. If snd_expr was a real expression that
computed a new value, then the next garbage collection
will reclaim the sound array. See also sound_save_sound()
*/
chans = getsize(sa);
if (chans > MAX_SND_CHANNELS) {
xlerror("sound_save: too many channels", sa);
free(buf);
sf_close(sndfile);
}
xlprot1(sa);
sa_copy = newvector(chans);
xlprot1(sa_copy);
/* Why do we copy the array into an xlisp array instead of just
* the state[i] array? Because some of these sounds may reference
* the lisp heap. We must put the sounds in an xlisp array so that
* the gc will find and mark them. xlprot1(sa_copy) makes the array
* visible to gc.
*/
for (i = 0; i < chans; i++) {
sound_type s = getsound(getelement(sa, i));
setelement(sa_copy, i, cvsound(sound_copy(s)));
}
sa = sa_copy; /* destroy original reference to allow GC */
state = (sound_state_type) malloc(sizeof(sound_state_node) * chans);
for (i = 0; i < chans; i++) {
state[i].sound = getsound(getelement(sa, i));
state[i].scale = state[i].sound->scale;
D nyquist_printf("save scale factor %ld = %g\n", i, state[i].scale);
state[i].terminated = false;
state[i].cnt = 0; /* force a fetch */
start_time = min(start_time, state[i].sound->t0);
}
for (i = 0; i < chans; i++) {
if (state[i].sound->t0 > start_time)
sound_prepend_zeros(state[i].sound, start_time);
}
debug_unit = debug_count = (long) max(sf_info->samplerate, 10000.0);
sound_frames = 0;
sound_srate = sf_info->samplerate;
while (n > 0) {
/* keep the following information for each sound:
has it terminated?
pointer to samples
number of samples remaining in block
scan to find the minimum remaining samples and
output that many in an inner loop. Stop outer
loop if all sounds have terminated
*/
int terminated = true;
int togo = n;
int j;
oscheck();
for (i = 0; i < chans; i++) {
if (state[i].cnt == 0) {
if (sndwrite_trace) {
nyquist_printf("CALLING SOUND_GET_NEXT ON CHANNEL %ld (%lx)\n",
i, (unsigned long) state[i].sound); /* jlh 64 bit issue */
sound_print_tree(state[i].sound);
}
state[i].ptr = sound_get_next(state[i].sound,
&(state[i].cnt))->samples;
if (sndwrite_trace) {
nyquist_printf("RETURNED FROM CALL TO SOUND_GET_NEXT ON CHANNEL %ld\n", i);
}
if (state[i].ptr == zero_block->samples) {
state[i].terminated = true;
}
}
if (!state[i].terminated) terminated = false;
togo = min(togo, state[i].cnt);
}
if (terminated) break;
float_bufp = (float *) buf;
if (is_pcm(sf_info)) {
for (j = 0; j < togo; j++) {
for (i = 0; i < chans; i++) {
float s = (float) (*(state[i].ptr++) * (float) state[i].scale);
COMPUTE_MAXIMUM_AND_WRAP(s);
*float_bufp++ = s;
}
}
} else {
for (j = 0; j < togo; j++) {
for (i = 0; i < chans; i++) {
float s = (float) (*(state[i].ptr++) * (float) state[i].scale);
COMPUTE_MAXIMUM();
*float_bufp++ = s;
}
}
}
/* Here we have interleaved floats. Before converting to the sound
file format, call PortAudio to play them. */
if (audio_stream) {
PaError err = Pa_WriteStream(audio_stream, buf, togo);
if (err) {
printf("Pa_WriteStream error %d\n", err);
}
sound_frames += togo;
}
if (sndfile) sf_writef_float(sndfile, buf, togo);
n -= togo;
for (i = 0; i < chans; i++) {
state[i].cnt -= togo;
}
*ntotal += togo;
if (*ntotal > debug_count) {
gprintf(TRANS, " %ld ", *ntotal);
fflush(stdout);
debug_count += debug_unit;
}
}
gprintf(TRANS, "total samples: %ld x %ld channels\n",
*ntotal, chans);
/* references to sounds are shared by sa_copy and state[].
* here, we dispose of state[], allowing GC to do the
* sound_unref call that frees the sounds. (Freeing them now
* would be a bug.)
*/
free(state);
xlpop();
return max_sample;
}
