mirror of
https://github.com/cookiengineer/audacity
synced 2025-04-30 15:49:41 +02:00
016919a53b
With recent changes to the Nyquist code for freeing blocks, the pointer 'next' could be uninitialised when 'list' points to the zero chain. So Audacity would follow a rogue pointer. We'd get away with it if the uninitialised value happened to be zero.
1732 lines
55 KiB
C
1732 lines
55 KiB
C
/* sound.c -- nyquist sound data type */
|
||
|
||
/* CHANGE LOG
|
||
* --------------------------------------------------------------------
|
||
* 28Apr03 dm changes for portability and fix compiler warnings
|
||
*/
|
||
|
||
/* define size_t: */
|
||
#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"
|
||
|
||
/* #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();
|
||
static void sound_xlprint();
|
||
static void sound_xlsave();
|
||
static unsigned char *sound_xlrestore();
|
||
|
||
void sound_print_array(LVAL sa, long n);
|
||
void sound_print_sound(sound_type s, 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
|
||
|
||
double sound_latency = 0.3; /* default value */
|
||
/* these are used so get times for *AUDIO-MARKERS* */
|
||
double sound_srate = 44100.0;
|
||
long sound_frames = 0;
|
||
|
||
double snd_set_latency(double latency)
|
||
{
|
||
double r = sound_latency;
|
||
sound_latency = latency;
|
||
return r;
|
||
}
|
||
|
||
|
||
long check_terminate_cnt(long 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(long 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)
|
||
{
|
||
int 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 %d", 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 = 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.
|
||
*/
|
||
long 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 (long) 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 (((long) sound) & 3) errputstr("sound not word aligned\n");
|
||
last_sound = sound; /* debug */
|
||
if (t0 < 0) xlerror("attempt to create a sound with negative starting time", s_unbound);
|
||
/* 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)
|
||
{
|
||
long 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 = (long) (((snd->true_t0 - t0) * snd->sr) + 0.5); /* 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 = snd_length(s, max_table_len);
|
||
long tx = 0; /* table index */
|
||
long 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)
|
||
snd_list_type snd_list;
|
||
{
|
||
snd_susp_type susp = snd_list->u.next->u.susp;
|
||
long lsc = susp->log_stop_cnt;
|
||
long 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;
|
||
|
||
list->refcnt--;
|
||
if (list->refcnt != 0) {
|
||
break; // the rest of the list is shared, nothing more to free
|
||
}
|
||
|
||
next = NULL;
|
||
// 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 */
|
||
int cnt; /* how many samples to flush */
|
||
sample_block_type sampblock = NULL;
|
||
long 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 = (long) 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;
|
||
long 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;
|
||
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)
|
||
{
|
||
long 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) ? (long) 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 = (long) 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, long * cnt)
|
||
{
|
||
long 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 = 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 */ {
|
||
long 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 = 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, long * cnt)
|
||
{
|
||
int 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 %d", 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 = 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.
|
||
****************************************************************************/
|
||
|
||
void add_s1_s2_nn_fetch(); /* for debugging */
|
||
|
||
/* 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, long * cnt)
|
||
{
|
||
register 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);
|
||
} else {
|
||
/* 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;
|
||
/* 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, long * cnt)
|
||
{
|
||
register 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(long *cnt_ptr, sound_type sound, snd_susp_type susp, long cnt)
|
||
{
|
||
long c = (long) ((((sound->current - cnt) / sound->sr + sound->t0) - susp->t0) *
|
||
susp->sr + 0.5);
|
||
/* 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
|
||
*/
|
||
long n = (long) ((when - sound->t0) * sound->sr + 0.5);
|
||
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
|
||
*/
|
||
void sound_print(snd_expr, n)
|
||
LVAL snd_expr;
|
||
long n;
|
||
{
|
||
LVAL result;
|
||
|
||
xlsave1(result);
|
||
result = xleval(snd_expr);
|
||
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("sound_print: array has non-sound element",
|
||
result);
|
||
}
|
||
}
|
||
sound_print_array(result, n);
|
||
} else if (exttypep(result, a_sound)) {
|
||
sound_print_sound(getsound(result), n);
|
||
} else {
|
||
xlerror("sound_print: expression did not return a sound",
|
||
result);
|
||
}
|
||
xlpop();
|
||
}
|
||
|
||
|
||
void sound_print_sound(sound_type s, long n)
|
||
{
|
||
int ntotal = 0;
|
||
long blocklen;
|
||
sample_block_type sampblock;
|
||
|
||
/* for debugging */
|
||
printing_this_sound = s;
|
||
|
||
nyquist_printf("sound_print: start at time %g\n", s->t0);
|
||
|
||
while (ntotal < n) {
|
||
if (s->logical_stop_cnt != UNKNOWN)
|
||
nyquist_printf("LST=%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("sound_print", sampblock,
|
||
MIN(blocklen, n - ntotal));
|
||
ntotal += blocklen;
|
||
}
|
||
nyquist_printf("total samples: %d\n", ntotal);
|
||
}
|
||
|
||
|
||
void sound_print_array(LVAL sa, long n)
|
||
{
|
||
long blocklen;
|
||
long i, len;
|
||
long upper = 0;
|
||
sample_block_type sampblock;
|
||
time_type t0, tmax;
|
||
|
||
len = getsize(sa);
|
||
if (len == 0) {
|
||
stdputstr("sound_print: 0 channels!\n");
|
||
return;
|
||
}
|
||
|
||
/* take care of prepending zeros if necessary */
|
||
t0 = tmax = (getsound(getelement(sa, 0)))->t0;
|
||
for (i = 1; i < len; 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 < len; 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("sound_print: start at time %g\n", t0);
|
||
|
||
while (upper < n) {
|
||
int i;
|
||
boolean done = true;
|
||
for (i = 0; i < len; i++) {
|
||
sound_type s = getsound(getelement(sa, i));
|
||
long 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("sound_print", sampblock,
|
||
MIN(blocklen, n - current));
|
||
current = s->current;
|
||
upper = MAX(upper, current);
|
||
}
|
||
}
|
||
if (done) break;
|
||
}
|
||
nyquist_printf("total: %d samples x %d channels\n",
|
||
(int)upper, (int)len);
|
||
}
|
||
|
||
|
||
/* 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 a GC is run to
|
||
* get rid of the original if there really are no other
|
||
* references. Finally, the copy is used to play the
|
||
* sounds.
|
||
*/
|
||
|
||
void sound_play(snd_expr)
|
||
LVAL snd_expr;
|
||
{
|
||
int ntotal;
|
||
long blocklen;
|
||
sample_block_type sampblock;
|
||
LVAL result;
|
||
sound_type s;
|
||
|
||
xlsave1(result);
|
||
result = xleval(snd_expr);
|
||
if (!exttypep(result, a_sound)) {
|
||
xlerror("sound_play: expression did not return a sound",
|
||
result);
|
||
}
|
||
|
||
ntotal = 0;
|
||
s = getsound(result);
|
||
/* 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 explicitly
|
||
free the copy since the garbage collector cannot find
|
||
it.
|
||
*/
|
||
s = sound_copy(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: %d\n", ntotal);
|
||
sound_unref(s);
|
||
xlpop();
|
||
}
|
||
|
||
|
||
/* 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);
|
||
/* stdputstr("HI THERE AGAIN\n");*/
|
||
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);
|
||
}
|
||
|
||
#ifdef WIN32
|
||
#ifndef _MSC_VER < 1800
|
||
#define RECIP_LOG_2 1.44269504088895364453
|
||
|
||
double log2(double x)
|
||
{
|
||
return log(x) * RECIP_LOG_2;
|
||
}
|
||
#endif
|
||
#endif
|
||
|
||
/*
|
||
* from old stuff...
|
||
*/
|
||
|
||
static void sound_xlfree(s)
|
||
sound_type s;
|
||
{
|
||
/* nyquist_printf("sound_xlfree(%p)\n", s);*/
|
||
sound_unref(s);
|
||
}
|
||
|
||
|
||
static void sound_xlprint(LVAL fptr, sound_type 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(fp, s)
|
||
FILE *fp;
|
||
sound_type 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 > 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 SEQ\n");
|
||
stdputstr("or SEQREP. The garbage collector assumes that sounds are\n");
|
||
stdputstr("not recursive or circular, and follows sounds to their\n");
|
||
stdputstr("end. After following a million nodes, I'm pretty sure\n");
|
||
stdputstr("that there is a cycle here, but since this is a bug,\n");
|
||
stdputstr("I cannot promise to recover. Prepare to crash. If you\n");
|
||
stdputstr("cannot locate 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(s)
|
||
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(s)
|
||
sound_type s;
|
||
{
|
||
/* nyquist_printf("cvsound(%p)\n", s);*/
|
||
return (cvextern(sound_desc, (unsigned char *) s));
|
||
}
|
||
|