audacia/lib-src/libnyquist/nyquist/nyqsrc/sound.c

1801 lines
58 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/* sound.c -- nyquist sound data type */
/* CHANGE LOG
* --------------------------------------------------------------------
* 28Apr03 dm changes for portability and fix compiler warnings
*/
/* define size_t: */
#include <limits.h>
#ifdef UNIX
#include "sys/types.h"
#endif
#include <stdio.h>
#include "xlisp.h"
#include "sound.h"
#include "falloc.h"
#include "samples.h"
#include "extern.h"
#include "debug.h"
#include "assert.h"
#ifdef OSC
#include "nyq-osc-server.h"
#endif
#include "cext.h"
#include "userio.h"
/* default maximum sample blocks:
* 1GB / (sample_block_len samples/block * 4 bytes/sample) */
long max_sample_blocks = 1000000000 / (max_sample_block_len * sizeof(float));
/* #define GC_DEBUG */
#ifdef GC_DEBUG
extern sound_type sound_to_watch;
#endif
snd_list_type list_watch; //DBY
/* #define SNAPSHOTS */
long table_memory;
sample_block_type zero_block;
sample_block_type internal_zero_block;
snd_list_type zero_snd_list;
xtype_desc sound_desc;
LVAL a_sound;
LVAL s_audio_markers;
static void sound_xlfree(void *);
static void sound_xlprint(LVAL, void *);
static void sound_xlsave(FILE *fp, void *s);
static unsigned char *sound_xlrestore(FILE *);
void sound_print_array(LVAL sa, long n);
void sound_print_sound(LVAL s_as_lval, long n);
void sample_block_unref(sample_block_type sam);
#ifdef SNAPSHOTS
boolean sound_created_flag = false;
#endif
#ifdef OSC
int nosc_enabled = false;
#endif
/* m is in bytes */
int64_t snd_set_max_audio_mem(int64_t m)
{
int64_t r = max_sample_blocks;
// avoid overflow since max_sample_blocks is long
int64_t msb = m / (max_sample_block_len * sizeof(float));
if (msb > LONG_MAX) msb = LONG_MAX;
max_sample_blocks = (long) msb;
return r * max_sample_block_len * sizeof(float);
}
double sound_latency = 0.3; /* default value */
/* these are used so get times for *AUDIO-MARKERS* */
double sound_srate = 44100.0;
int64_t sound_frames = 0;
double snd_set_latency(double latency)
{
double r = sound_latency;
sound_latency = latency;
return r;
}
int64_t check_terminate_cnt(int64_t tc)
{
if (tc < 0) {
xlfail("duration is less than 0 samples");
tc = 0; /* this should not be reached */
}
return tc;
}
/* xlbadsr - report a "bad combination of sample rates" error */
LVAL snd_badsr(void)
{
xlfail("bad combination of sample rates");
return NIL; /* never happens */
}
/* compute-phase - given a phase in radians, a wavetable specified as
* the nominal pitch (in half steps), the table length, and the sample
* rate, compute the sample number corresponding to the phase. This
* routine makes it easy to initialize the table pointer at the beginning
* of various oscillator implementations in Nyquist. Note that the table
* may represent several periods, in which case phase 360 is not the same
* as 0. Also note that the phase increment is also computed and returned
* through incr_ptr.
*/
double compute_phase(phase, key, n, srate, new_srate, freq, incr_ptr)
double phase; /* phase in degrees (depends on ANGLEBASE) */
double key; /* the semitone number of the table played at srate */
long n; /* number of samples */
double srate; /* the sample rate of the table */
double new_srate; /* sample rate of the result */
double freq; /* the desired frequency */
double *incr_ptr; /* the sample increment */
{
double period = 1.0 / step_to_hz(key);
/* convert phase to sample units */
phase = srate * period * (phase / (double) ANGLEBASE);
/* phase is now in sample units; if phase is less than zero, then increase
it by some number of sLength's to make it positive:
*/
if (phase < 0)
phase += (((int) ((-phase) / n)) + 1) * n;
/* if phase is longer than the sample length, wrap it by subtracting the
integer part of the division by sLength:
*/
if (phase > n)
phase -= ((int) (phase / n)) * n;
/* Now figure the phase increment: to reproduce original pitch
required incr = srate / new_srate. To get the new frequency,
scale by freq / nominal_freq = freq * period:
*/
*incr_ptr = (srate / new_srate) * freq * period;
return phase;
}
#ifndef GCBUG
snd_list_type gcbug_snd_list = 0;
long blocks_to_watch_len = 0;
sample_block_type blocks_to_watch[blocks_to_watch_max];
void block_watch(int64_t sample_block)
{
if (blocks_to_watch_len >= blocks_to_watch_max) {
stdputstr("block_watch - no more space to save pointers\n");
return;
}
blocks_to_watch[blocks_to_watch_len++] = (sample_block_type) sample_block;
nyquist_printf("block_watch - added %d = %x\n",
(int)sample_block, (int)sample_block);
}
/* fetch_zeros -- the fetch function for appended zeros */
/*
* zeros are appended when the logical stop time exceeds the
* (physical) terminate time. This fetch function is installed
* by snd_list_terminate(). When appending zeros, we just return
* a pointer to the internal_zero_block and increment current until
* it reaches log_stop_cnt. Then we call snd_list_terminate() to
* finish off the sound list.
*/
void fetch_zeros(snd_susp_type susp, snd_list_type snd_list)
{
int64_t len = MIN(susp->log_stop_cnt - susp->current,
max_sample_block_len);
/* nyquist_printf("fetch_zeros, lsc %d current %d len %d\n",
susp->log_stop_cnt, susp->current, len); */
if (len < 0) {
char error[80];
sprintf(error, "fetch_zeros susp %p (%s) len %" PRId64,
susp, susp->name, len);
xlabort(error);
}
if (len == 0) { /* we've reached the logical stop time */
/* nyquist_printf("fetch_zeros: reached the logical stop in %s cnt %d\n",
susp->name, susp->log_stop_cnt); */
snd_list_terminate(snd_list);
} else {
snd_list->block_len = (short) len;
susp->current += len;
}
}
/* sound_nth_block - fetch the address of the nth sample block of a sound */
/*
* NOTE: intended to be called from lisp. Lisp can then call block_watch
* to keep an eye on the block.
*/
int64_t sound_nth_block(sound_type snd, long n)
{
long i;
snd_list_type snd_list = snd->list;
for (i = 0; i < n; i++) {
if (i == 1) {
gcbug_snd_list = snd_list;
nyquist_printf("gcbug_snd_list = 0x%p\n", gcbug_snd_list);
}
if (!snd_list->block) return 0;
snd_list = snd_list->u.next;
}
if (snd_list->block) return (int64_t) snd_list->block;
else return 0;
}
#endif
/****************************************************************************
* snd_list_create
* Inputs:
* snd_susp_type susp: A reference to the suspension
* Result: snd_list_type
* A newly-created sound list type
* Effect:
* Allocates and initializes a snd_list node:
* block refcnt block_len susp logically_stopped
* +--------+--------+-------+-------+---+
* |////////| 1 | 0 | susp | F |
* +--------+--------+-------+-------+---+
****************************************************************************/
/* snd_list_create -- alloc and initialize a snd_list node */
/**/
snd_list_type snd_list_create(snd_susp_type susp)
{
snd_list_type snd_list;
falloc_snd_list(snd_list, "snd_list_create");
snd_list->block = NULL; /* no block of samples */
snd_list->u.susp = susp; /* point to suspension */
snd_list->refcnt = 1; /* one ref */
snd_list->block_len = 0; /* no samples */
snd_list->logically_stopped = false;/* not stopped */
/* nyquist_printf("snd_list_create => %p\n", snd_list);*/
return snd_list;
}
/****************************************************************************
* sound_create
* Inputs:
* snd_susp_type susp: The suspension block to be used for this sound
* time_type t0: The initial time for this sound
* rate_type sr: The sampling rate for this sound
* sample_type scale: The scaling factor for this sound
* sample_block_type (*proc)(...): The get_next_sound method
* Result: sound_type
*
* Effect:
* Creates and initializes a sound type
* Notes:
* The MSDOS conditional is actually a test for ANSI headers; the
* presence of float parameters means that an ANSI prototype and
* a non-ANSI header are incompatible. Better solution would be
* to ANSIfy source.
****************************************************************************/
sound_type last_sound = NULL;
sound_type sound_create(
snd_susp_type susp,
time_type t0,
rate_type sr,
promoted_sample_type scale)
{
sound_type sound;
falloc_sound(sound, "sound_create");
if (((intptr_t) sound) & 3) errputstr("sound not word aligned\n");
last_sound = sound; /* debug */
if (t0 < 0) xlfail("attempt to create a sound with negative starting time");
/* nyquist_printf("sound_create %p gets %g\n", sound, t0); */
sound->t0 = sound->true_t0 = sound->time = t0;
sound->stop = MAX_STOP;
sound->sr = sr;
sound->current = 0;
sound->scale = (float) scale;
sound->list = snd_list_create(susp);
sound->get_next = SND_get_first;
sound->logical_stop_cnt = UNKNOWN;
sound->table = NULL;
sound->extra = NULL;
/* nyquist_printf("sound_create susp %p snd_list %p\n", susp, sound->list);
nyquist_printf("sound_create'd %p\n", sound); */
#ifdef SNAPSHOTS
sound_created_flag = true;
#endif
#ifdef GC_DEBUG
if (sound == sound_to_watch) {
nyquist_printf("Created watched sound\n");
watch_snd_list(sound->list);
}
#endif
return sound;
}
/* sound_prepend_zeros -- modify sound_type so that it starts at t0 */
/*
* assumes t0 is earlier than snd->t0, so the sound should return zeros
* until snd->t0 is reached, after which we revert to normal computation.
* When we return, the new snd->t0 will be t0, meaning that the first
* sample returned will be at time t0.
* NOTE: t0 may not be an exact multiple of samples earlier than snd->t0,
* but Nyquist allows any sound to be shifted by +/- 0.5 samples in
* order to achieve alignment. Since sound_prepend_zeros can be called
* many times on the same sound_type, there is a chance that rounding
* errors could accumulate. My first solution was to return with
* snd->t0 computed exactly and not reflecting any fractional sample
* shift of the signal, but this caused problems for the caller: a
* fractional sample shift at a low sample rate could correspond to
* many client samples,fooling the client into thinking that some
* initial samples should be discarded (or else requiring the client
* to be pretty smart). The solution used here is to return to the
* client with snd->t0 exactly equal to t0, but to save snd->true_t0
* equal to the time of the first sample with no sound shifting. This
* time is used for any future sound_prepend_zeros operations so that
* any accumulated rounding errors are due only to floating point
* precision and not to accumulated fractional sample shifts of snd.
*/
void sound_prepend_zeros(sound_type snd, time_type t0)
{
int64_t n;
/* first, see if we're already prepending some zeros */
if (snd->get_next != SND_get_zeros) {
/* nyquist_printf("sound_prepend_zeros 1: snd->t0 %g t0 %g\n", snd->t0, t0); */
/* if not, then initialize some fields that support prepending */
snd->prepend_cnt = 0;
snd->true_t0 = snd->t0;
/* save old get_next and plug in special get_next function */
snd->after_prepend = snd->get_next;
snd->get_next = SND_get_zeros;
}
n = ROUNDBIG((snd->true_t0 - t0) * snd->sr); /* how many samples to prepend */
/* add to prepend_cnt so first sample will correspond to new t0 */
snd->prepend_cnt += n;
/* compute the true t0 which corresponds to the time of first sample */
snd->true_t0 -= (n / snd->sr);
/* make caller happy by claiming the sound now starts at exactly t0;
* this is always true within 0.5 samples as allowed by Nyquist. */
snd->t0 = t0;
/* nyquist_printf("sound_prepend_zeros: snd %p true_t0 %g sr %g n %d\n",
snd, snd->true_t0, snd->sr, n);*/
}
/* sound_array_copy -- copy an array of sounds */
/*
* NOTE: be sure to protect the result from gc!
*/
LVAL sound_array_copy(LVAL sa)
{
long i = getsize(sa);
LVAL new_sa = newvector(i);
xlprot1(new_sa);
while (i > 0) {
i--;
setelement(new_sa, i,
cvsound(sound_copy(getsound(getelement(sa, i)))));
}
xlpop();
return new_sa;
}
/* sound_copy - copy a sound structure, do reference counts */
/**/
sound_type sound_copy(sound_type snd)
{
sound_type sndcopy;
falloc_sound(sndcopy, "sound_copy");
*sndcopy = *snd; /* copy the whole structure */
sndcopy->extra = NULL; /* except for the (private) extra data */
snd_list_ref(snd->list); /* copied a reference so fix the count */
/* nyquist_printf("sound_copy'd %p to %p\n", snd, sndcopy); */
if (snd->table) snd->table->refcount++;
#ifdef GC_DEBUG
if (sndcopy == sound_to_watch)
printf("sndcopy->table %x\n", sndcopy->table);
#endif
return sndcopy;
}
/* convert a sound to a wavetable, set length */
/**/
table_type sound_to_table(sound_type s)
{
long len = (long) snd_length(s, max_table_len);
long tx = 0; /* table index */
int blocklen;
register double scale_factor = s->scale;
sound_type original_s = s;
table_type table; /* the new table */
long table_bytes; /* how big is the table */
if (s->table) {
s->table->refcount++;
return s->table;
}
if (len >= max_table_len) {
char emsg[100];
sprintf(emsg, "maximum table size (%d) exceeded", max_table_len);
xlcerror("use truncated sound for table", emsg, NIL);
} else if (len == 0) {
xlabort("table size must be greater than 0");
}
len++; /* allocate extra sample at end of table */
s = sound_copy(s);
/* nyquist_printf("sound_to_table: allocating table of size %d\n", len); */
table_bytes = table_size_in_bytes(len);
table = (table_type) malloc(table_bytes);
if (!table) xlfail("osc_init couldn't allocate memory for table");
table_memory += table_bytes;
table->length = (double) (len - 1);
while (len > 1) {
sample_block_type sampblock = sound_get_next(s, &blocklen);
long togo = MIN(blocklen, len);
long i;
sample_block_values_type sbufp = sampblock->samples;
/* nyquist_printf("in sound_to_table, sampblock = %d\n", sampblock);*/
for (i = 0; i < togo; i++) {
table->samples[tx++] = (float) (*sbufp++ * scale_factor);
}
len -= togo;
}
/* for interpolation, duplicate first sample at end of table */
table->samples[tx] = table->samples[0];
table->refcount = 2; /* one for the user, one from original_s */
sound_unref(s);
s = NULL;
original_s->table = table;
return table;
}
void table_free(table_type table)
{
long len = (long) (table->length) + 1;
long bytes = table_size_in_bytes(len);
free(table);
table_memory -= bytes;
}
void table_unref(table_type table)
{
if (!table) return;
table->refcount--;
if (table->refcount <= 0) {
/* nyquist_printf("table refcount went to zero\n"); */
table_free(table);
}
}
void sound_unref(sound_type snd)
/* note that sounds do not have ref counts, so sound_unref
* always frees the sound object
*/
{
if (!snd) return;
snd_list_unref(snd->list);
table_unref(snd->table);
/* nyquist_printf("\t\t\t\t\tfreeing sound@%p\n", snd);*/
if (snd->extra) free(snd->extra);
ffree_sound(snd, "sound_unref");
}
void snd_list_ref(snd_list_type list)
{
list->refcnt++;
}
void snd_list_terminate(snd_list_type snd_list)
{
snd_susp_type susp = snd_list->u.next->u.susp;
int64_t lsc = susp->log_stop_cnt;
int64_t current = susp->current;
/* unreference the empty sample block that was allocated: */
sample_block_unref(snd_list->block);
/* use zero_block instead */
snd_list->block = zero_block;
/* either fetch more zeros or terminate now */
if (lsc != UNKNOWN && lsc > current) {
/* nyquist_printf("snd_list_terminate: lsc %d current %d\n",
lsc, current); */
susp->fetch = fetch_zeros;
fetch_zeros(susp, snd_list);
} else {
snd_list->block_len = max_sample_block_len;
snd_list->logically_stopped = true;
snd_list_unref(snd_list->u.next);
snd_list->u.next = zero_snd_list; /* be zero forever */
}
}
void snd_list_unref(snd_list_type list)
{
if (list == NULL) {
nyquist_printf("why did snd_list_unref get %p?\n", list);
return;
}
while (list && (list != zero_snd_list)) {
snd_list_type next = NULL;
list->refcnt--;
if (list->refcnt != 0) {
break; // the rest of the list is shared, nothing more to free
}
// list nodes either point to a block of samples or this is the
// last list node (list->block == NULL) which points to a suspension
// lists can also terminate at the zero_block, which is an infinite
// shared list (zero_block->block == zero_block) of zero samples
if (list->block && list->block != zero_block) {
/* there is a next snd_list */
next = list->u.next;
sample_block_unref(list->block);
} else if (list->block == NULL) { /* the next thing is the susp */
/* free suspension structure */
/* nyquist_printf("freeing susp@%p\n", list->u.susp); */
(*(list->u.susp->free))(list->u.susp);
}
/* if (list == list_watch)
printf("freeing watched snd_list %p\n", list); */
ffree_snd_list(list, "snd_list_unref");
list = next;
}
}
void sample_block_ref(sample_block_type sam)
{
sam->refcnt++;
}
void sample_block_test(sample_block_type sam, char *s)
{
/* see if this block is being watched */
int i;
for (i = 0; i < blocks_to_watch_len; i++) {
if ((sam > (blocks_to_watch[i] - 1)) &&
(sam < (blocks_to_watch[i] + 1))) {
nyquist_printf(
"WOOPS! %s(0x%p) refers to a block 0x%p on the watch list!\n",
s, sam, blocks_to_watch[i]);
}
}
}
void sample_block_unref(sample_block_type sam)
{
sam->refcnt--;
if (sam->refcnt == 0) {
#ifndef GCBUG
sample_block_test(sam, "sample_block_unref");
#endif
/* nyquist_printf("freeing sample block %p\n", sam); */
ffree_sample_block(sam, "sample_block_unref");
}
}
/****************************************************************************
* interp_style
* Inputs:
* sound_type s: The sound we are using
* rate_type sr: The sampling rate
* Result: int
* A small integer which is one of the symbolic values:
* The values are ordered, smallest to largest, as
* INTERP_n - none
* INTERP_s - scale
* INTERP_i - interpolated
* INTERP_r - ramp
*
* Notes:
* The sampling rate s->sr and scale factor s->scale are compared
* with other values exactly (no fuzz).
****************************************************************************/
int interp_style(sound_type s, rate_type sr)
{
if (s->sr == sr)
{ /* same sample rate */
return ((s->scale == 1.0) ? INTERP_n : INTERP_s);
} /* same sample rate */
else
if (s->sr * 10.0 > sr)
{ /* 10x sample rate */
return INTERP_i;
} /* 10x sample rate */
else
return INTERP_r;
}
/****************************************************************************
* snd_sort_2
* Inputs:
* sound_type * s1_ptr:
* sound_type * s2_ptr:
* rate_type sr:
* Result: void
*
* Effect:
* If the interp_style of s1 dominates the interp_style of s2,
* the sound_types input are interchanged.
****************************************************************************/
/* snd_sort_2 -- sort 2 arguments by interpolation method */
void snd_sort_2(sound_type *s1_ptr, sound_type *s2_ptr, rate_type sr)
{
if (interp_style(*s1_ptr, sr) > interp_style(*s2_ptr, sr)) {
sound_type s = *s1_ptr;
*s1_ptr = *s2_ptr;
*s2_ptr = s;
}
}
/* snd_sref -- access a sound at a given time point */
/**/
double snd_sref(sound_type s, time_type t)
{
double exact_cnt; /* how many fractional samples to scan */
int64_t cnt; /* how many samples to flush */
sample_block_type sampblock = NULL;
int blocklen;
sample_type x1, x2; /* interpolate between these samples */
/* changed true_t0 to just t0 based on comment that true_t0 is only
* for use by snd_prepend_zeros -RBD
*/
exact_cnt = (t - s->t0) * s->sr;
if (exact_cnt < 0.0) return 0.0;
s = sound_copy(s); /* don't modify s, create new reader */
cnt = (int64_t) exact_cnt; /* rounds down */
exact_cnt -= cnt; /* remember fractional remainder */
/* now flush cnt samples */
while (cnt >= 0) {
sampblock = sound_get_next(s, &blocklen);
cnt -= blocklen;
if (sampblock == zero_block) {
sound_unref(s);
return 0.0;
}
}
/* -blocklen <= cnt <= -1 */
/* get next 2 samples and interpolate */
x1 = sampblock->samples[blocklen + cnt];
if (cnt == -1) {
sampblock = sound_get_next(s, &blocklen);
cnt -= blocklen;
}
x2 = sampblock->samples[blocklen + cnt + 1];
sound_unref(s); /* free the reader */
return (x1 + exact_cnt * (x2 - x1)) * s->scale;
}
/* snd_sref_inverse -- find time point corresponding to some value */
/**/
double snd_sref_inverse(sound_type s, double val)
{
double exact_cnt; /* how many fractional samples to scan */
int i;
sample_block_type sampblock;
int blocklen;
sample_type x1, x2; /* interpolate between these samples */
if (val < 0) {
xlcerror("return 0", "negative value", cvflonum(val));
return 0.0;
}
s = sound_copy(s); /* don't modify s, create new reader */
x1 = 0.0F;
/* now flush cnt samples */
while (true) {
sampblock = sound_get_next(s, &blocklen);
x2 = sampblock->samples[blocklen - 1];
if (x2 >= val) break;
x1 = x2;
if (sampblock == zero_block) {
xlcerror("return 0", "too large, no inverse", cvflonum(val));
sound_unref(s);
return 0.0;
}
}
/* x1 = last sample of previous block,
sampblock contains a value larger than val
blocklen is the length of sampblock */
/* search for first element exceeding val - could
* use binary search, but maximum block size places
* an upper bound on how bad this can get and we
* search for the right block linearly anyway.
*/
for (i = 0; i < blocklen && sampblock->samples[i] <= val; i++) ;
/* now i is index of element exceeding val */
if (i > 1) x1 = sampblock->samples[i - 1];
x2 = sampblock->samples[i];
/* now interpolate to get fractional part */
if (x2 == x1) exact_cnt = 0;
else exact_cnt = (val - x1) / (x2 - x1);
/* and add the sample count of x1 */
exact_cnt += (s->current - blocklen) + (i - 1);
/* negative counts are possible because the first x1 is at
* sample -1, so force the location to be at least 0
*/
if (exact_cnt < 0) exact_cnt = 0;
/* compute time = t0 + count / samplerate; */
exact_cnt = s->t0 + exact_cnt / s->sr;
sound_unref(s); /* free the reader */
return exact_cnt;
}
time_type snd_stop_time(sound_type s)
{
if (s->stop == MAX_STOP) return MAX_STOP_TIME;
/* I think placing the stop time 0.5 samples later than the last
is to avoid rounding errors somewhere. Sounds are supposed
to be open-ended on the right, and I would guess s->stop
should be one greater than the actual number of samples.
Therefore, it seems that 0.5 should be 0.0 so that
converting back to sample count will round to s->stop.
I'm not changing this because it has been this way for
a long time and Nyquist seems to get it right. -RBD */
else return s->t0 + (s->stop + 0.5) / s->sr;
}
/* snd_xform -- return a sound with transformations applied */
/*
* The "logical" sound starts at snd->time and runs until some
* as yet unknown termination time. (There is also a possibly
* as yet unknown logical stop time that is irrelevant here.)
* The sound is clipped (zero) until snd->t0 and after snd->stop,
* the latter being a sample count, not a time_type.
* So, the "physical" sound starts at snd->t0 and runs for up to
* snd->stop samples (or less if the sound terminates beforehand).
*
* The snd_xform procedure operates at the "logical" level, shifting
* the sound from its snd->time to time. The sound is stretched as
* a result of setting the sample rate to sr. It is then (further)
* clipped between start_time and stop_time. If initial samples
* are clipped, the sound is shifted again so that it still starts
* at time. The sound is then scaled by scale.
*
* To support clipping of initial samples, the "physical" start time
* t0 is set to when the first unclipped sample will be returned, but
* the number of samples to clip is saved as a negative count. The
* fetch routine SND_flush is installed to flush the clipped samples
* at the time of the first fetch. SND_get_first is then installed
* for future fetches.
*
* An empty (zero) sound will be returned if all samples are clipped.
*
*/
sound_type snd_xform(sound_type snd,
rate_type sr,
time_type time,
time_type start_time,
time_type stop_time,
promoted_sample_type scale)
{
int64_t start_cnt, stop_cnt; /* clipping samples (sample 0 at new t0) */
/* start_cnt should reflect max of where the sound starts (t0)
* and the new start_time.
*/
if (start_time == MIN_START_TIME) {
start_cnt = 0;
} else {
double new_start_cnt = ((start_time - time) * sr) + 0.5;
start_cnt = ((new_start_cnt > 0) ? (int64_t) new_start_cnt : 0);
}
/* if (start_cnt < -(snd->current)) start_cnt = -(snd->current); */
/* stop_cnt should reflect min of the new stop_time and the previous
* snd->stop.
*/
if (stop_time == MAX_STOP_TIME) {
stop_cnt = MAX_STOP;
} else {
double new_stop_cnt = ((stop_time - time) * sr) + 0.5;
if (new_stop_cnt < MAX_STOP) {
stop_cnt = (int64_t) new_stop_cnt;
} else {
errputstr("Warning: stop count overflow in snd_xform\n");
stop_cnt = MAX_STOP;
}
}
if (stop_cnt > snd->stop) {
stop_cnt = snd->stop;
}
if (stop_cnt < 0 || start_cnt >= stop_cnt) {
snd = sound_create(NULL, time, sr, 1.0);
/* sound_create goes ahead and allocates a snd_list node, so
* we need to free it.
* Calling snd_list_unref here seems like the right thing, but
* it assumes too much structure is in place. ffree_snd_list
* is simpler and more direct:
*/
ffree_snd_list(snd->list, "snd_xform");
snd->list = zero_snd_list;
/* nyquist_printf("snd_xform: (stop_time < t0 or start >= stop) "
"-> zero sound = %p\n", snd); */
} else {
snd = sound_copy(snd);
snd->t0 = time;
if (start_cnt) {
snd->current -= start_cnt; /* indicate flush with negative num. */
/* the following code assumes that SND_get_first is the
routine to be called to get the first samples from this
sound. We're going to replace it with SND_flush. First,
make sure that the assumption is correct:
*/
if ((snd->get_next != SND_get_first) &&
(snd->get_next != SND_flush)) {
errputstr("snd_xform: SND_get_first expected\n");
EXIT(1);
}
/* this will flush -current samples and revert to SND_get_first */
snd->get_next = SND_flush;
stop_cnt -= start_cnt;
}
snd->stop = stop_cnt;
snd->sr = sr;
snd->scale *= (float) scale;
}
return snd;
}
/* SND_flush -- the get_next function for flushing clipped samples */
/*
* this only gets called once: it flushes -current samples (a
* non-real-time operation) and installs SND_get_next to return
* blocks normally from then on.
*/
sample_block_type SND_flush(sound_type snd, int *cnt)
{
int mycnt;
sample_block_type block = SND_get_first(snd, &mycnt);
/* changed from < to <= because we want to read at least the first sample */
while (snd->current <= 0) {
block = SND_get_next(snd, &mycnt);
}
/* at this point, we've read to and including the block with
* the first samples we want to return. If the block boundary
* is in the right place, we can do a minimal fixup and return:
*/
if (snd->current == snd->list->block_len) {
*cnt = (int) snd->current; /* == snd->list->block_len */
/* snd->get_next = SND_get_next; -- done by SND_get_first */
return block;
} else /* snd->current < snd->list->block_len */ {
int64_t i;
sample_block_values_type from_ptr;
/* we have to return a partial block */
/* NOTE: if we had been smart, we would have had SND_get_next
* return a pointer to samples rather than a pointer to the
* block, which has a reference count. Since the caller
* expects a pointer to a reference count, we have to copy
* snd->current samples to a new block
*/
snd_list_type snd_list = snd_list_create((snd_susp_type) snd->list->u.next);
snd_list->u.next->refcnt++;
falloc_sample_block(snd_list->block, "SND_flush");
/* now copy samples */
from_ptr = block->samples + snd->list->block_len - snd->current;
for (i = 0; i < snd->current; i++) {
snd_list->block->samples[i] = from_ptr[i];
}
snd_list_unref(snd->list);
snd->list = snd_list;
*cnt = (int) snd->current;
return snd_list->block;
}
}
/* SND_get_zeros -- the get_next function for prepended zeros */
/*
* when prepending zeros, we just return a pointer to the internal_zero_block
* and decrement the prepend_cnt until it goes to zero. Then we revert to
* the normal (original) get_next function.
*
*/
sample_block_type SND_get_zeros(sound_type snd, int *cnt)
{
int64_t len = MIN(snd->prepend_cnt, max_sample_block_len);
/* stdputstr("SND_get_zeros: "); */
if (len < 0) {
char error[80];
sprintf(error, "SND_get_zeros snd %p len %" PRId64, snd, len);
xlabort(error);
}
if (len == 0) { /* we've finished prepending zeros */
snd->get_next = snd->after_prepend;
/* stdputstr("done, calling sound_get_next\n"); fflush(stdout); */
return sound_get_next(snd, cnt);
} else {
*cnt = (int) len;
snd->current += len;
snd->prepend_cnt -= len;
/* nyquist_printf("returning internal_zero_block@%p\n", internal_zero_block);
fflush(stdout); */
return internal_zero_block;
}
}
/****************************************************************************
* SND_get_next
* Inputs:
* sound_type snd: The iterator whose next block is to be computed
* int * cnt: Place to put count of samples returned
* Result: snd_list_type
* Pointer to the sample block computed ---------------------------+
* Effect: |
* force suspension to compute next block of samples |
* |
* Here's the protocol for using this and related functions: |
* Every client (sample reader) has a private sound_type (an iterator), |
* and the sound_type's 'list' field points to a header (of type |
* snd_list_type). The header in turn points to a block of samples. |
* |
* +---------------------------------------+
* |
* |
* | sample_block_type
* (snd) V +---+--+--+--+--+--+--+-...-+--+
* sound_type: snd_list_type +-->|ref| | | | |//|//| |//|
* +---------+ +----------+ | +---+--+--+--+--+--+--+-...-+--+
* | list +------->| block +--+ ^
* +---------+ +----------+ :
* | t0 | | block_len|....................:
* +---------+ +----------+
* | sr | | refcnt |
* +---------+ +-+--------+
* | current | | next +---->... Note: the union u
* +---------+ |u|........| snd_list_type points to only one
* | rate | | | susp +---->... of the indicated
* +---------+ +-+--------+ susp_type types
* | scalse | |log_stop |
* +---------+ +----------+
* | lsc |
* +---------+
* |get_next +-----> SND_get_next()
* +---------+
*
* The sound_type keeps track of where the next sample block will
* come from. The field 'current' is the number of the first sample of
* the next block to be returned, where sample numbers start
* at zero. The normal fetch procedure is this one, although special
* cases may generate special block generators, e.g., CONST does not need
* to allocate and refill a block and can reuse the same block over and
* over again, so it may have its own fetch procedure. This is the
* general fetch procedure, which assumes that the generator function
* actually produces a slightly different value for each sample.
*
* The distinguishing characteristic of whether the 'u' field is to be
* interpreted as 'next', a link to the next list element, or 'susp', a
* reference to the suspension for generating a new sample block, is
* whether the 'block' parameter is NULL or not. If it is NULL, then
* u.susp tells how to generate the block; if it is not NULL, u.next is
* a pointer to the next sound block in the list.
*
* When the 'block' pointer is NULL, we create a block of samples, and
* create a new sound list element which follows it which has a NULL
* 'block' pointer; the 'u' field of the current list element is now
* interpreted as 'u.next'.
*
* The client calls SND_get_next to get a pointer to a block of samples.
* The count of samples generated is returned via a ref parameter, and
* SND_get_next will not be called again until this set is exhausted.
*
* The next time SND_get_next is called, it knows that the sample block
* has been exhausted. It releases its reference to the block (and if
* that was the last reference, frees the block to the block allocation
* pool), allocates a new block from the block pool, and proceeds to
* fill it with samples.
*
* Note that as an optimization, if the refcnt field goes to 0 it
* could immediately re-use the block without freeing back to the block
* pool and reallocating it.
*
* Because of the way we handle sound sample blocks, the sound sample blocks
* themselves are ref-counted, so freeing the snd_list_type may not free
* the sample block it references. At the level of this procedure, that
* is transparently handled by the snd_list_unref function.
*
* Logical stop:
*
* Logical stop is handled by several mechanisms. The /intrinsic/ logical
* stop is an immutable property of the signal, and is determined by the
* specification in the algorithm description file. When it is encountered,
* the 'logically_stopped' flag of the snd_list_node is set.
* The generators guarantee that the first time this is encountered, it
* will always be constructed so that the first sample of the block it
* references is the logical stop time.
*
* In addition, the client may have set the /explicit logical stop time/ of
* the iterator (e.g., in nyquist, the (set-logical-stop sound time) call copies
* the sound, altering its logical stop). The logical stop time, when set
* in this way, causes the logical_stop_cnt ('lsc' in the above diagram)
* to be set to the count of the last sample to be generated before the
* <logical stop time. This will guarantee that the sound will indicate that
* it has reached its logical stop time when the indicated sample is
* generated.
****************************************************************************/
/* for debugging */
void add_s1_s2_nn_fetch(snd_susp_type a_susp, snd_list_type snd_list);
/* SND_get_first -- the standard fn to get a block, after returning
* the first block, plug in SND_get_next for successive blocks
*/
sample_block_type SND_get_first(sound_type snd, int *cnt)
{
snd_list_type snd_list = snd->list;
/*
* If there is not a block of samples, we need to generate one.
*/
if (snd_list->block == NULL) {
/*
* Call the 'fetch' method for this sound_type to generate
* a new block of samples.
*/
snd_susp_type susp = snd_list->u.susp;
snd_list->u.next = snd_list_create(susp);
snd_list->block = internal_zero_block;
/* nyquist_printf("SND_get_first: susp->fetch %p\n",
susp->fetch); */
assert(susp->log_stop_cnt == UNKNOWN || susp->log_stop_cnt >= 0);
(*(susp->fetch))(susp, snd_list);
#ifdef GC_DEBUG
snd_list_debug(snd_list, "SND_get_first");
#endif
/* nyquist_printf("SND_get_first: snd_list %p, block %p, length %d\n",
snd_list, snd_list->block, snd_list->block_len); */
}
if ((snd->logical_stop_cnt == UNKNOWN) && snd_list->logically_stopped) {
/* nyquist_printf("SND_get_first/next: snd %p logically stopped at %d\n",
snd, snd->current); */
snd->logical_stop_cnt = snd->current;
}
/* see if clipping needs to be applied */
if (snd->current + snd_list->block_len > snd->stop) {
/* need to clip: is clip on a block boundary? */
if (snd->current == snd->stop) {
/* block boundary: replace with zero sound */
snd->list = zero_snd_list;
snd_list_unref(snd_list);
// the idea here is that we have reached snd->stop, which
// means the next samples have to be zero, but we are reading
// from the middle of a block of samples. Maybe, for example,
// snd was constructed by snd_xform that imposed a new stop
// time. Since we haven't read the next sample, we can take
// care of this by just creating a new snd_list with a shorter
// block_len to take whatever samples we need before stop, then
// link ot zero_snd_list so that subsequent samples are zero.
// However, if we actually start reading zeros from zero_snd_list,
// the test above for > snd->stop will bring us back here. We
// ignore these cases just below by testing if the current list
// is the zero_snd_list. If so, we're just reading zeros, we're
// past the stop time, and we can just keep reading zeros, so
// do nothing.
} else if (snd->list != zero_snd_list) {
/* not a block boundary: build new list */
snd->list = snd_list_create((snd_susp_type) zero_snd_list);
snd->list->block_len = (short) (snd->stop - snd->current);
snd->list->block = snd_list->block;
snd->list->block->refcnt++;
snd_list_unref(snd_list);
}
snd_list = snd->list; /* used below to return block ptr */
}
*cnt = snd_list->block_len;
assert(snd_list->block_len >= 0);
/* this should never happen */
if (*cnt == 0) {
stdputstr("SND_get_first returned 0 samples\n");
#if DEBUG_MEM
dbg_mem_print("snd_list info:", snd_list);
dbg_mem_print("block info:", snd_list->block);
#endif
sound_print_tree(snd);
stdputstr("It is possible that you created a recursive sound\n");
stdputstr("using something like: (SETF X (SEQ (SOUND X) ...))\n");
stdputstr("Nyquist aborts from non-recoverable error\n");
abort();
}
snd->current += snd_list->block_len; /* count how many we read */
snd->get_next = SND_get_next;
return snd_list->block;
}
sample_block_type SND_get_next(sound_type snd, int *cnt)
{
snd_list_type snd_list = snd->list;
/*
* SND_get_next is installed by SND_get_first, so we know
* when we are called that we are done with the current block
* of samples, so free it now.
*/
snd_list_type cur = snd_list;
snd->list = snd_list = cur->u.next;
snd_list_ref(snd_list);
snd_list_unref(cur); /* release the reference to the current block */
/* now that we've deallocated, we can use SND_get_first to finish the job */
return SND_get_first(snd, cnt);
}
/****************************************************************************
* make_zero_block
* Inputs:
*
* Result:
*
* Effect:
*
****************************************************************************/
sample_block_type make_zero_block(void)
{
sample_block_type zb;
int i;
falloc_sample_block(zb, "make_zero_block");
/* leave room for lots more references before overflow,
but set the count high so that even a large number of
dereferences will not lead to a deallocation */
zb->refcnt = 0x6FFFFFFF;
for (i = 0; i < max_sample_block_len; i++)
{ /* fill with zeros */
zb->samples[i] = 0.0F;
} /* fill with zeros */
return zb;
}
/* min_cnt -- help compute the logical stop or terminate as minimum */
/*
* take the sound (which has just logically stopped or terminated at
* current sample) and
* convert the stop sample into the equivalent sample count as produced by
* susp (which may have a different sample rate). If the count is less than
* the current *cnt_ptr, overwrite cnt_ptr with a new minimum. By calling
* this when each of S1, S2, ... Sn reach their logical stop or termiate
* points, *cnt_ptr will end up with the minimum stop count, which is what
* we want. NOTE: the logical stop time and terminate for signal addition
* should be the MAX of logical stop times of arguments, so this routine
* would not be used.
*/
void min_cnt(int64_t *cnt_ptr, sound_type sound, snd_susp_type susp, long cnt)
{
int64_t c = ROUNDBIG((((sound->current - cnt) / sound->sr + sound->t0) - susp->t0) *
susp->sr);
/* if *cnt_ptr is uninitialized, just plug in c, otherwise compute min */
if ((*cnt_ptr == UNKNOWN) || (*cnt_ptr > c)) {
/* nyquist_printf("min_cnt %p: new count is %d\n", susp, c);*/
/* if (c == 0) sound_print_tree(printing_this_sound);*/
*cnt_ptr = c;
}
}
/****************************************************************************
* sound_init
* Result: void
*
* Effect:
* Module initialization
* Allocates the 'zero block', the infinitely linked block of
* 0-valued sounds. This is referenced by a list element which
* refers to itself.
****************************************************************************/
void sound_init(void)
{
zero_block = make_zero_block();
internal_zero_block = make_zero_block();
falloc_snd_list(zero_snd_list, "sound_init");
zero_snd_list->block = zero_block;
zero_snd_list->u.next = zero_snd_list;
zero_snd_list->refcnt = 2;
zero_snd_list->block_len = max_sample_block_len;
zero_snd_list->logically_stopped = true;
#ifdef GC_DEBUG
{ long s;
stdputstr("sound_to_watch: ");
scanf("%p", &s);
watch_sound((sound_type) s);
}
#endif
sound_desc = create_desc("SOUND", sound_xlfree, sound_xlprint,
sound_xlsave, sound_xlrestore, sound_xlmark);
}
/* sound_scale -- copy and change scale factor of a sound */
/**/
sound_type sound_scale(double factor, sound_type snd)
{
sound_type sndcopy = sound_copy(snd);
sndcopy->scale *= (float) factor;
return sndcopy;
}
/****************************************************************************
* set_logical_stop_time
* Inputs:
* sound_type sound: The sound for which the logical stop time is
* being set
* time_type when: The logical stop time, expressed as an absolute
* time.
* Result: void
*
* Effect:
* Converts the time 'when' into a count of samples.
****************************************************************************/
void set_logical_stop_time(sound_type sound, time_type when)
{
/*
'when' is an absolute time. The number of samples to
be generated is the number of samples between 't0' and
'when'.
-----------+---+---+---+---+---+---+---+---+---+
| |
t0 when
*/
int64_t n = ROUNDBIG((when - sound->t0) * sound->sr);
if (n < 0) {
xlcerror("retain the current logical stop",
"logical stop sample count is negative", NIL);
} else {
sound->logical_stop_cnt = n;
}
}
/* for debugging
sound_type printing_this_sound = NULL;
void ((**watch_me)()) = NULL;
void set_watch(where)
void ((**where)());
{
if (watch_me == NULL) {
watch_me = where;
nyquist_printf("set_watch: watch_me = %p\n", watch_me);
}
}
*/
/*
* additional routines
*/
/* snd_list_len - for debugging: how many sample blocks held? */
long snd_list_len(void *inst)
{
int i = 0;
sound_type snd = (sound_type) inst;
snd_list_type list = snd->list;
while (list->block && list->block != zero_block && list->block_len != 0) {
i++;
list = list->u.next;
}
return i;
}
/* sound_print - implement SND-PRINT, based on sound_save in sndwritepa.c */
/**/
void sound_print(snd_expr, n)
LVAL snd_expr;
long n;
{
LVAL result;
result = xleval(snd_expr);
/* BE CAREFUL - DO NOT ALLOW GC TO RUN WHILE RESULT IS UNPROTECTED */
if (vectorp(result)) {
/* make sure all elements are of type a_sound */
long i = getsize(result);
while (i > 0) {
i--;
if (!exttypep(getelement(result, i), a_sound)) {
xlerror("SND-PRINT: array has non-sound element",
result);
}
}
sound_print_array(result, n);
} else if (soundp(result)) {
sound_print_sound(result, n);
} else {
xlprot1(result);
xlerror("sound_print: expression did not return a sound",
result);
xlpop();
}
}
/* sound_print_sound - implements SND-PRINT for mono signal */
/**/
void sound_print_sound(LVAL s_as_lval, long n)
{
int ntotal = 0;
sound_type s;
int blocklen;
sample_block_type sampblock;
/* for debugging
printing_this_sound = s;
*/
xlprot1(s_as_lval);
s = sound_copy(getsound(s_as_lval));
s_as_lval = cvsound(s); /* destroys our reference to original */
nyquist_printf("SND-PRINT: start at time %g\n", s->t0);
while (ntotal < n) {
if (s->logical_stop_cnt != UNKNOWN) {
nyquist_printf("logical stop time (in samples): %d ",
(int)s->logical_stop_cnt);
}
sound_print_tree(s);
sampblock = sound_get_next(s, &blocklen);
if (sampblock == zero_block || blocklen == 0) {
break;
}
print_sample_block_type("SND-PRINT", sampblock,
MIN(blocklen, n - ntotal));
ntotal += blocklen;
}
nyquist_printf("total samples: %d\n", ntotal);
xlpop();
}
void sound_print_array(LVAL sa, long n)
{
int blocklen;
long i, chans;
LVAL sa_copy;
long upper = 0;
sample_block_type sampblock;
time_type t0, tmax;
chans = getsize(sa);
if (chans == 0) {
stdputstr("SND-PRINT: 0 channels!\n");
return;
}
xlprot1(sa);
sa_copy = newvector(chans);
xlprot1(sa_copy);
/* To be non-destructive, copy sounds from sa to sa_copy. */
for (i = 0; i < chans; i++) {
sound_type s = getsound(getelement(sa, i));
setelement(sa_copy, i, cvsound(sound_copy(s)));
}
/* If sa and sounds in sa are not accessible, we do not want to retain
* them because they will accumulate the computed samples.
*/
sa = sa_copy; /* destroy original reference to (maybe) allow GC */
/* take care of prepending zeros if necessary */
t0 = tmax = (getsound(getelement(sa, 0)))->t0;
for (i = 1; i < chans; i++) {
sound_type s = getsound(getelement(sa, i));
t0 = MIN(s->t0, t0);
tmax = MAX(s->t0, tmax);
}
/* if necessary, prepend zeros */
if (t0 != tmax) {
stdputstr("prepending zeros to channels: ");
for (i = 0; i < chans; i++) {
sound_type s = getsound(getelement(sa, i));
if (t0 < s->t0) {
nyquist_printf(" %d ", (int)i);
sound_prepend_zeros(s, t0);
}
}
stdputstr("\n");
}
nyquist_printf("SND-PRINT: start at time %g\n", t0);
while (upper < n) {
int i;
boolean done = true;
for (i = 0; i < chans; i++) {
sound_type s = getsound(getelement(sa, i));
int64_t current = -1; /* always get first block */
while (current < upper) {
sampblock = sound_get_next(s, &blocklen);
if (sampblock != zero_block && blocklen != 0) {
done = false;
}
current = s->current - blocklen;
nyquist_printf("chan %d current %d:\n", i, (int)current);
print_sample_block_type("SND-PRINT", sampblock,
(int) MIN(blocklen, n - current));
current = s->current;
upper = (long) MAX(upper, current);
}
}
if (done) break;
}
nyquist_printf("total: %d samples x %d channels\n",
(int)upper, (int)chans);
xlpopn(2); // sa and sa_copy
}
/* sound_play -- compute sound, do not retain samples */
/*
* NOTE: we want the capability of computing a sound without
* retaining samples. This requires that no references to
* the sound exist, but if the sound is passed as an argument,
* the argument stack will have a reference. So, we pass in
* an expression that evaluates to the sound we want. The
* expression is eval'd, the result copied (in case the
* expression was a sound or a global variable and we really
* want to preserve the sound), and then GC will
* get rid of the original if there really are no other
* references.
*/
int64_t sound_play(snd_expr)
LVAL snd_expr;
{
int64_t ntotal;
int blocklen;
sample_block_type sampblock;
LVAL result;
sound_type s;
xlsave1(result);
result = xleval(snd_expr);
if (!exttypep(result, a_sound)) {
xlerror("SND-PLAY: expression did not return a sound",
result);
}
ntotal = 0;
/* if snd_expr was simply a symbol, then result 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.
*/
s = sound_copy(getsound(result));
result = cvsound(s);
while (1) {
#ifdef OSC
if (nosc_enabled) nosc_poll();
#endif
sampblock = sound_get_next(s, &blocklen);
if (sampblock == zero_block || blocklen == 0) {
break;
}
/* print_sample_block_type("sound_play", sampblock, blocklen); */
ntotal += blocklen;
}
nyquist_printf("total samples: %" PRId64 "\n", ntotal);
xlpop();
return ntotal;
}
/* sound_print_tree -- print a tree version of sound structure */
/**/
void sound_print_tree(snd)
sound_type snd;
{
/* nyquist_printf("sample_block_free %p\n", sample_block_free);*/
nyquist_printf("SOUND PRINT TREE of %p\n", snd);
sound_print_tree_1(snd, 0);
}
void indent(int n)
{
while (n-- > 0) stdputstr(" ");
}
void sound_print_tree_1(snd, n)
sound_type snd;
int n;
{
int i;
snd_list_type snd_list;
if (n > 100) {
stdputstr("... (skipping remainder of sound)\n");
return;
}
if (!snd) {
stdputstr("\n");
return;
}
nyquist_printf("sound_type@%p(%s@%p)t0 "
"%g stop %d sr %g lsc %d scale %g pc %d",
snd,
(snd->get_next == SND_get_next ? "SND_get_next" :
(snd->get_next == SND_get_first ? "SND_get_first" : "?")),
snd->get_next, snd->t0, (int)snd->stop, snd->sr,
(int)snd->logical_stop_cnt, snd->scale,
(int)snd->prepend_cnt);
snd_list = snd->list;
nyquist_printf("->snd_list@%p", snd_list);
if (snd_list == zero_snd_list) {
stdputstr(" = zero_snd_list\n");
return;
}
for (i = 0; ; i++) {
if (snd_list == zero_snd_list) {
if (i > 1) nyquist_printf(" (skipping %d) ", i-1);
stdputstr("->zero_snd_list\n");
return;
}
if (!snd_list->block) {
if (i > 0) nyquist_printf(" (skipping %d) ", i);
stdputstr("->\n");
indent(n + 2);
nyquist_printf("susp@%p(%s)toss_cnt %d "
"current %d lsc %d sr %g t0 %g %p\n",
snd_list->u.susp, snd_list->u.susp->name,
(int)snd_list->u.susp->toss_cnt,
(int)snd_list->u.susp->current,
(int)snd_list->u.susp->log_stop_cnt,
snd_list->u.susp->sr,
snd_list->u.susp->t0, snd_list);
susp_print_tree(snd_list->u.susp, n + 4);
return;
}
snd_list = snd_list->u.next;
}
}
/* mark_audio_time -- record the current playback time
*
* The global variable *audio-markers* is treated as a list.
* When the user types ^Q, this function pushes the current
* playback time onto the list
*/
void mark_audio_time()
{
double playback_time = sound_frames / sound_srate - sound_latency;
LVAL time_node = cvflonum(playback_time);
setvalue(s_audio_markers, cons(time_node, getvalue(s_audio_markers)));
gprintf(TRANS, " %g ", playback_time);
fflush(stdout);
}
/* compute constants p1 and p2:
pitchconvert(0) * 2 = pitchconvert(12) - octaves
exp(p2) * 2 = exp(12 * p1 + p2)
2 = exp(12 * p1)
log(2) = 12 * p1
p1 = log(2.0)/12;
pitchconvert(69) gives 440Hz
exp(69 * p1 + p2) = 440
69 * p1 + p2 = log(440)
p2 = log(440.0) - (69 * p1);
*/
#define p1 0.0577622650466621
#define p2 2.1011784386926213
double hz_to_step(double hz)
{
return (log(hz) - p2) / p1;
}
double step_to_hz(double steps)
{
return exp(steps * p1 + p2);
}
/*
* from old stuff...
*/
static void sound_xlfree(void *s)
{
sound_unref((sound_type)s);
}
static void sound_xlprint(LVAL fptr, void *s)
{
/* the type cast from s to LVAL is OK because
* putatm does not dereference the 3rd parameter */
putatm(fptr, "Sound", (LVAL) s);
}
static void sound_xlsave(FILE *fp, void *s)
{
stdputstr("sound_save called\n");
}
static unsigned char *sound_xlrestore(FILE *fp)
{
stdputstr("sound_restore called\n");
return NULL;
}
/* sound_xlmark -- mark LVAL nodes reachable from this sound */
/**/
void sound_xlmark(void *a_sound)
{
sound_type s = (sound_type) a_sound;
snd_list_type snd_list;
long counter = 0;
#ifdef TRACESNDGC
nyquist_printf("sound_xlmark(%p)\n", s);
#endif
if (!s) return; /* pointers to sounds are sometimes NULL */
snd_list = s->list;
while (snd_list->block != NULL) {
if (snd_list == zero_snd_list) {
#ifdef TRACESNDGC
stdputstr(" terminates at zero_snd_list\n");
#endif
return;
} else if (counter > max_sample_blocks) {
/* exceded maximum length of sound in memory */
} else if (counter > 1000000) {
stdputstr("You created a recursive sound! This is a Nyquist bug.\n");
stdputstr("The only known way to do this is by a SETF on a\n");
stdputstr("local variable or parameter that is being passed to\n");
stdputstr("SEQ or SEQREP. The garbage collector assumes that\n");
stdputstr("sounds are not recursive or circular, and follows\n");
stdputstr("sounds to their end. After following 1M nodes,\n");
stdputstr("I'm pretty sure that there is a\n");
stdputstr("cycle here, but since this is a bug, I cannot promise\n");
stdputstr("to recover. Prepare to crash. If you cannot locate\n");
stdputstr("the cause of this, contact the author -RBD.\n");
}
snd_list = snd_list->u.next;
counter++;
}
if (snd_list->u.susp->mark) {
#ifdef TRACESNDGC
nyquist_printf(" found susp (%s) at %p with mark method\n",
snd_list->u.susp->name, snd_list->u.susp);
#endif
(*(snd_list->u.susp->mark))(snd_list->u.susp);
} else {
#ifdef TRACESNDGC
nyquist_printf(" no mark method on susp %p (%s)\n",
snd_list->u.susp, snd_list->u.susp->name);
#endif
}
}
void sound_symbols()
{
a_sound = xlenter("SOUND");
s_audio_markers = xlenter("*AUDIO-MARKERS*");
setvalue(s_audio_markers, NIL);
}
/* The SOUND Type: */
boolean soundp(LVAL s)
{
return (exttypep(s, a_sound));
}
/* sound_zero - create and return a zero that terminates now */
/**/
sound_type sound_zero(time_type t0,rate_type sr)
{
sound_type sound;
falloc_sound(sound, "sound_zero");
sound->get_next = SND_get_first;
sound->list = zero_snd_list;
sound->logical_stop_cnt = sound->current = 0;
sound->true_t0 = sound->t0 = sound->time = t0;
sound->stop = MAX_STOP;
sound->sr = sr;
sound->scale = 1.0F;
sound->table = NULL;
sound->extra = NULL;
return sound;
}
LVAL cvsound(sound_type s)
{
/* nyquist_printf("cvsound(%p)\n", s);*/
return (cvextern(sound_desc, (unsigned char *) s));
}