/* xleval - evaluate an xlisp expression (checking for *evalhook*) */
LVAL xleval(LVAL expr)
{
/* check for control codes */
if (--xlsample <= 0) {
xlsample = SAMPLE;
oscheck();
}
/* check for *evalhook* */
if (getvalue(s_evalhook))
return (evalhook(expr));
/* check for nil */
if (null(expr))
return (NIL);
/* dispatch on the node type */
switch (ntype(expr)) {
case CONS:
return (evform(expr));
case SYMBOL:
return (xlgetvalue(expr));
default:
return (expr);
}
}
/* xleval - evaluate an xlisp expression (checking for *evalhook*) */
NODE *xleval(NODE *expr)
{
/* check for control codes */
if (--xlsample <= 0) {
xlsample = SAMPLE;
oscheck();
}
/* check for *evalhook* */
if (getvalue(s_evalhook))
return (evalhook(expr));
/* add trace entry */
if (++xltrace < TDEPTH)
trace_stack[xltrace] = expr;
/* check type of value */
if (consp(expr))
expr = evform(expr);
else if (symbolp(expr))
expr = xlgetvalue(expr);
/* remove trace entry */
--xltrace;
/* return the value */
return (expr);
}
/* ostputc - put a character to the terminal */
void ostputc(int ch)
{
oscheck(); /* check for control characters */
if (nyx_output_cb) {
nyx_output_cb(ch, nyx_output_ud);
}
else {
putchar((char) ch);
}
}
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;
}
sample_type sound_save_sound(LVAL s_as_lval, long n, SF_INFO *sf_info,
SNDFILE *sndfile, float *buf, long *ntotal, PaStream *audio_stream)
{
long blocklen;
sound_type s;
int i;
sample_type *samps;
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;
/* jlh cvtfn_type cvtfn; */
*ntotal = 0;
/* if snd_expr was simply a symbol, then s now points to
a shared sound_node. If we read samples from it, then
the sound 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_node. We need to make the new
sound reachable by the garbage collector to that any
lisp data reachable from the sound do not get collected.
To make the sound reachable, we need to allocate a node,
and the GC might run, so we need to protect the OLD s
but then make it unreachable.
We will let the GC collect the sound in the end.
*/
xlprot1(s_as_lval);
s = sound_copy(getsound(s_as_lval));
s_as_lval = cvsound(s); /* destroys only ref. to original */
/* for debugging */
/* printing_this_sound = s;*/
debug_unit = debug_count = (long) max(sf_info->samplerate, 10000.0);
sound_frames = 0;
sound_srate = sf_info->samplerate;
while (n > 0) {
long togo;
sample_block_type sampblock = sound_get_next(s, &blocklen);
oscheck();
#ifdef SNAPSHOTS
stdputstr(".");
if (sound_created_flag) {
stdputstr("SNAPSHOT: ");
sound_print_tree(printing_this_sound);
sound_created_flag = false;
}
fflush(stdout);
#endif
if (sampblock == zero_block || blocklen == 0) {
break;
}
togo = min(blocklen, n);
if (s->scale != 1) { /* copy/scale samples into buf */
for (i = 0; i < togo; i++) {
buf[i] = s->scale * sampblock->samples[i];
}
samps = buf;
} else {
samps = sampblock->samples;
}
if (is_pcm(sf_info)) {
for (i = 0; i < togo; i++) {
sample_type s = samps[i];
COMPUTE_MAXIMUM_AND_WRAP(samps[i]);
}
} else {
for (i = 0; i < togo; i++) {
sample_type s = samps[i];
COMPUTE_MAXIMUM();
}
}
if (sndfile) {
sf_writef_float(sndfile, samps, togo);
}
if (audio_stream) {
Pa_WriteStream(audio_stream, samps, togo);
sound_frames += togo;
}
n -= togo;
*ntotal += togo;
if (*ntotal > debug_count) {
gprintf(TRANS, " %ld ", *ntotal);
fflush(stdout);
debug_count += debug_unit;
}
}
gprintf(TRANS, "\ntotal samples: %ld\n", *ntotal);
xlpop();
return max_sample;
}
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;
}
sample_type sound_save_sound(LVAL s_as_lval, long n, snd_type snd,
char *buf, long *ntotal, snd_type player)
{
long blocklen;
long buflen;
sound_type s;
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;
/* if snd_expr was simply a symbol, then s now points to
a shared sound_node. If we read samples from it, then
the sound 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_node. We need to make the new
sound reachable by the garbage collector to that any
lisp data reachable from the sound do not get collected.
To make the sound reachable, we need to allocate a node,
and the GC might run, so we need to protect the OLD s
but then make it unreachable.
We will let the GC collect the sound in the end.
*/
xlprot1(s_as_lval);
s = sound_copy(getsound(s_as_lval));
s_as_lval = cvsound(s); /* destroys only ref. to original */
/* for debugging */
/* printing_this_sound = s;*/
debug_unit = debug_count = (long) max(snd->format.srate, 10000.0);
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
while (n > 0) {
long togo;
float peak;
sample_block_type sampblock = sound_get_next(s, &blocklen);
oscheck();
#ifdef SNAPSHOTS
stdputstr(".");
if (sound_created_flag) {
stdputstr("SNAPSHOT: ");
sound_print_tree(printing_this_sound);
sound_created_flag = false;
}
fflush(stdout);
#endif
if (sampblock == zero_block || blocklen == 0) {
break;
}
togo = min(blocklen, n);
buflen = (*cvtfn)((void *) buf, (void *) sampblock->samples,
togo, s->scale, &peak);
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;
*ntotal += togo;
if (*ntotal > debug_count) {
gprintf(TRANS, " %d ", *ntotal);
fflush(stdout);
debug_count += debug_unit;
}
}
gprintf(TRANS, "\ntotal samples: %d\n", *ntotal);
xlpop();
return max_sample;
}
