diff options
Diffstat (limited to 'nyqsrc')
98 files changed, 22053 insertions, 0 deletions
diff --git a/nyqsrc/add.c b/nyqsrc/add.c new file mode 100644 index 0000000..0b518f1 --- /dev/null +++ b/nyqsrc/add.c @@ -0,0 +1,917 @@ +/* add.c -- add two signals */ +/* CHANGE LOG + * 19May92 rbd fix t0 to mean time rather than samples + fix to logically stop and terminate at MAX of 2 inputs + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +/* DOCUMENTATION: + Most DSP modules in Nyquist select a single fetch routine +and use it until the signal terminates. The ADD operation +instead can use a number of different fetch routines in sequence. +This allows ADD to do the most efficient computation, such as +simply copying pointers when only one input signal is defined +(the other is zero.) + Here's what the functions assume and do: +add_s1_s2_nn_fetch: both arguments (s1, s2) have signals; add + them. +add_s1_nn_fetch: only s1 is active, so pass along pointers if + possible. Revert to add_s1_s2_nn_fetch when s2 becomes active. +add_s2_nn_fetch: symetric with add_s1_nn_fetch. +add_zero_fill_nn_fetch: fill in when one input has terminated and + the other hasn't begun. + +An important optimization (we think) is the ability to collapse +ADD operations. When one operand goes to zero, the ADD just +passes along pointers to blocks from the other operand. In some +cases, we can just splice out the ADD suspension and link +directly to the suspension of the second operand. + +Doing this requires that there be no scale factors, so ADD does +not deal with scaling. If an operand comes in with a scale +factor, ADD will create a rescaling of the operand. +*/ + +#include "switches.h" +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "cext.h" +#include "scale.h" +#include "multiseq.h" +#include "add.h" +#include "assert.h" + + +#define debugA 0 +#define A if (debugA) +/* I don't know how these debug switches (A and D) differ: */ +#define D A + +/* switch B is/was to look for a particular zero block length bug */ +#define debugB 0 +#define B if (debugB | debugA) + +/* #define GC_DEBUG 1 */ + + +void add_s1_s2_nn_fetch(add_susp_type, snd_list_type); +void add_s1_nn_fetch(add_susp_type, snd_list_type); +void add_s2_nn_fetch(add_susp_type, snd_list_type); +void add_zero_fill_nn_fetch(add_susp_type, snd_list_type); +void add_free(); + + +void add_s1_s2_nn_fetch(susp, snd_list) + register add_susp_type susp; + snd_list_type snd_list; +{ + int cnt = 0; /* how many samples computed */ + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + register sample_block_values_type s1_ptr_reg; + register sample_block_values_type s2_ptr_reg; + register sample_block_values_type out_ptr_reg; + +#ifdef GC_DEBUG + snd_list_report(snd_list, "add_s1_s2_nn_fetch"); +#endif + /* assume the snd_list is the one with a null block */ + /* put a fresh, clean block in the snd_list (get new snd_list later) */ + falloc_sample_block(out, "add_s1_s2_nn_fetch"); + snd_list->block = out; + out_ptr = out->samples; +A nyquist_printf("add[%p,%p] (s1_s2_nn) %p new block %p\n", + susp->s1, susp->s2, susp, out); + + /* fill up the new block */ + while (cnt < max_sample_block_len && susp->terminate_bits == 0) { +A nyquist_printf("add[%p,%p] (s1_s2_nn) %p starting outer loop, cnt %d\n", + susp->s1, susp->s2, susp, cnt); + + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = max_sample_block_len - cnt; + + /* don't run past the s1 input sample block: */ +A nyquist_printf("add[%p,%p]: look for samples (for s1) \n", susp->s1, susp->s2); +/* if (!susp->s1->list->block) watch_susp(susp->s1->list->u.susp); */ + susp_check_term_log_block_samples(s1, s1_bptr, s1_ptr, s1_cnt, 1, 3); +A nyquist_printf("add[%p,%p]: found samples (for s1) s1_cnt=%d\n", + susp->s1, susp->s2, (int)susp->s1_cnt); + togo = MIN(togo, susp->s1_cnt); + if (susp->terminate_bits & 1) { +A nyquist_printf("add[%p,%p]: terminate bits on (for s1) togo=%d\n", + susp->s1, susp->s2, togo); + } + + /* don't run past the s2 input sample block: */ +A nyquist_printf("add[%p,%p]: look for samples (for s2) \n", susp->s1, susp->s2); + susp_check_term_log_block_samples(s2, s2_bptr, s2_ptr, s2_cnt, 2, 3); +A nyquist_printf("add[%p,%p]: found samples (for s2) s2_cnt=%d\n", + susp->s1, susp->s2, (int)susp->s2_cnt); + togo = MIN(togo, susp->s2_cnt); +A if (susp->terminate_bits & 2) { + nyquist_printf("add[%p,%p]: terminate bits on (for s2) togo=%d\n", + susp->s1, susp->s2, togo); + } + + /* don't run past logical stop time (need to check this even + * if a sound has terminated) + */ +A nyquist_printf( + "add[%p,%p] (s1_s2_nn) %p: logically_stopped %d, logical_stop_cnt %d, s1 logical_stop_cnt %ld, s2 logical_stop_cnt %ld \n", + susp->s1, susp->s2, susp, susp->logically_stopped, + (int) susp->susp.log_stop_cnt, + susp->s1->logical_stop_cnt, + susp->s2->logical_stop_cnt); + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN && + (susp->logical_stop_bits == 3)) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); +A nyquist_printf("add[%p,%p]: to_stop = %d\n", susp->s1, susp->s2, to_stop); + /* logical stops have to be indicated on block boundaries */ + if (to_stop < togo) { + if (to_stop == 0) { + if (cnt) { + togo = 0; + break; /* block is non-empty, log-stop on next block */ + } else /* to_stop is 0, indicate logical stop immediately */ + susp->logically_stopped = true; + } else { + /* logical stop will take place on the following block, + * so compute up to logical stop and return partial block + */ + togo = to_stop; + } + } + } + + /* check please */ + if (susp->terminate_bits) { + break; + } + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); +D nyquist_printf("add[%p,%p]: togo = %d\n", susp->s1, susp->s2, togo); + if (togo == 0) break; + } + + n = togo; +A nyquist_printf("add[%p,%p] (s1_s2_nn) %p starting inner loop, n %d\n", + susp->s1, susp->s2, susp, n); + s1_ptr_reg = susp->s1_ptr; + s2_ptr_reg = susp->s2_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + /* scale? */ +A nyquist_printf("add_s1_s2_nn: %g + %g\n", *s1_ptr_reg, *s2_ptr_reg); + *out_ptr_reg++ = *(s1_ptr_reg++) + *(s2_ptr_reg++); + } while (--n); /* inner loop */ + /* using s1_ptr_reg is a bad idea on RS/6000 */ + susp->s1_ptr += togo; + /* using s2_ptr_reg is a bad idea on RS/6000 */ + susp->s2_ptr += togo; + /* using out_ptr_reg is a bad idea on RS/6000 */ + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(s2_cnt, togo); + cnt += togo; + } /* outer loop */ + +A nyquist_printf("add[%p,%p] (s1_s2_nn) %p ending outer loop, cnt %d\n", + susp->s1, susp->s2, susp, cnt); + + snd_list->block_len = cnt; + + /* test for logical stop - normally this is detected by + * susp.log_stop_cnt == susp->susp.current, but then the logical + * stop flag is set on the NEXT block. To remember to set on the + * NEXT block, set susp->logically_stopped, which is also tested + * below. One special case is if the current block should indicate + * logically stopped (this happens sometimes when the sounds have + * zero logical length) then susp->logically_stopped will be set + * (see above) and we just never test susp->susp.log_stop_cnt. + */ + if (susp->logically_stopped) { +A nyquist_printf("add[%p,%p] (s1_s2_nn) %p->logically_stopped already true\n", + susp->s1, susp->s2, susp); + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current && + susp->logical_stop_bits == 3) { +A nyquist_printf("add[%p,%p] (s1_s2_nn) %p->logically_stopped set to true\n", + susp->s1, susp->s2, susp); + susp->logically_stopped = true; + } + + /* test for termination of s1 */ + if (susp->terminate_bits == 3) { +D nyquist_printf("add[%p,%p] (s1_s2_nn) s1 and s2 terminated, unrefed\n", + susp->s1, susp->s2); + /* free susp and point to terminal zeros (leaving pending snd_lists)*/ + if (cnt) { + /* we have samples, put zero_block at end */ + snd_list_unref(snd_list->u.next); + snd_list->u.next = zero_snd_list; + } else { + /* no samples generated */ + snd_list_terminate(snd_list); + } +D nyquist_printf("add[%p,%p] (s1_s2_nn) %p terminated.\n", + susp->s1, susp->s2, susp); + } else { + if (susp->terminate_bits & 1) { +D nyquist_printf("add[%p,%p] (s1_s2_nn) s1 terminated, unrefed\n", + susp->s1, susp->s2); + sound_unref(susp->s1); + susp->s1 = NULL; + susp->susp.fetch = add_s2_nn_fetch; +D nyquist_printf("add_s1_s2_nn_fetch: add_s2_nn_fetch installed\n"); + if (cnt == 0) { +D nyquist_printf("add[%p,%p]: calling add_s2_nn_fetch\n", + susp->s1, susp->s2); + add_s2_nn_fetch(susp, snd_list); + } + } + else if (susp->terminate_bits & 2) { +D nyquist_printf("add[%p,%p] (s1_s2_nn) s2 terminated, unrefed\n", + susp->s1, susp->s2); + sound_unref(susp->s2); + susp->s2 = NULL; + susp->susp.fetch = add_s1_nn_fetch; +D stdputstr("add_s1_s2_nn_fetch: add_s1_nn_fetch installed\n"); + if (cnt == 0) { +D nyquist_printf("add[%p,%p]: calling add_s1_nn_fetch\n", + susp->s1, susp->s2); + add_s1_nn_fetch(susp, snd_list); + } + } + + /* add a new snd_list for the susp */ + susp->susp.current += cnt; + } + +} /* add_s1_s2_nn_fetch */ + + + +/* Note that add_s1_nn_fetch and add_s2_nn_fetch are symetric. + * They should probably be made into one routine, but for now, + * any changes to one should be made to the other. + */ +void add_s1_nn_fetch(susp, snd_list) + register add_susp_type susp; + snd_list_type snd_list; +{ + /* expansion of add_s_nn_fetch(snd_list,s1,s2,1); follows: */ + int togo, s2_start=0; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + +D nyquist_printf("add_s1_nn_fetch(susp %p, snd_list %p, s1_cnt %d)\n", + susp, snd_list, (int)susp->s1_cnt); + +#ifdef GC_DEBUG + snd_list_report(snd_list, "add_s1_nn_fetch"); +#endif + /* + * first compute how many samples to copy (or transfer) + */ + + /* see what the next samples look like */ + susp_check_term_log_block_samples(s1, s1_bptr, + s1_ptr, s1_cnt, 1, 3); +B if (susp->terminate_bits & 1) + nyquist_printf("add[%p,%p]: s1 terminates\n", susp->s1, susp->s2); + + /* don't run past the s1 input sample block: */ + togo = susp->s1_cnt; +B if (togo == 0) stdputstr("togo is zero at checkpoint 1\n"); + + /* don't run past terminate time of this signal */ +/* if (susp->s1_ptr == zero_block->samples) { -sep21 RBD*/ + if (susp->terminate_bits & 1) { + if (susp->s2) { + s2_start = (long) ((susp->s2->t0 - susp->susp.t0) * + susp->s2->sr + 0.5); +D nyquist_printf("add_s_nn_fetch: s2_start %d\n", s2_start); + } + togo = 0; +B if (togo == 0) stdputstr("togo is zero at checkpoint 2\n"); + if (susp->s2 && susp->susp.current == s2_start) { + /* s2 starting and s1 stops */ + /* go to s2 alone state */ + sound_unref(susp->s1); + susp->s1 = NULL; + susp->susp.fetch = add_s2_nn_fetch; +D stdputstr("add_s_nn_fetch: other installed, calling now...\n"); + add_s2_nn_fetch(susp, snd_list); + } else if (susp->s2 && susp->susp.current < s2_start) { + /* s2 not started and s1 stops */ + /* go to zero-fill state */ + sound_unref(susp->s1); + susp->s1 = NULL; + susp->susp.fetch = add_zero_fill_nn_fetch; +B stdputstr("add_s_nn_fetch: zero_fill installed\n"); + add_zero_fill_nn_fetch(susp, snd_list); + } else if (susp->s2) { +D stdputstr("add_s_nn_fetch: unexpected condition\n"); + EXIT(1); + } else /* no s2 */ { + snd_list_terminate(snd_list); + } +D nyquist_printf("add_s_nn_fetch: special return, susp %p\n", susp); + return; /* fetching taken care of by another routine */ + } +/* if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + togo) { + togo = susp->terminate_cnt - susp->susp.current; + } + */ + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN && + susp->logical_stop_bits == 3) { + int to_stop = susp->susp.log_stop_cnt - susp->susp.current; + if (to_stop < togo) { + if (to_stop == 0) { + susp->logically_stopped = true; + } else togo = to_stop; + } +B if (togo == 0) stdputstr("togo is zero at checkpoint 3\n"); +D nyquist_printf("add_s1_nn_fetch: to_stop %d togo %d\n", to_stop, togo); + } + + /* consider other signal? don't run past its start time... */ + if (susp->s2) { + s2_start = ROUND((susp->s2->t0 - susp->susp.t0) * + susp->s2->sr); + if (s2_start < susp->susp.current + togo) + togo = MIN(togo, s2_start - susp->susp.current); +B if (togo == 0) stdputstr("togo is zero at checkpoint 4\n"); + } + + /* + * two cases: copy a partial block or manipulate pointers for + * copyless transfer of whole block (may not be full block): + * + * copy partial block when: + * o samples begin in middle of block + * o stopping time is before end of block (when other signal + * splits the block for this signal) + * transfer (copyless) block when: + * o the block is of maximum size + * o the block is small due to logical stop time or termination + * time + */ + if (susp->s1_ptr == susp->s1_bptr->samples && + susp->s1_cnt == togo) { + /* + * we want to copy this whole block (starting at the beginning + * and going to the rest of the block) -- just do pointers. + */ + + /* just fetch and pass blocks on */ + if (0) nyquist_printf("add[%p,%p] (s%d_nn) %p starting uncopy, togo %d\n", susp->s1, susp->s2, + 1, susp, togo); + snd_list->block = susp->s1_bptr; + (susp->s1_bptr->refcnt)++; + if (0) nyquist_printf("add[%p,%p] (s%d_nn) %p shared block %p zero_block %p\n",susp->s1, susp->s2, + 1, susp, susp->s1_bptr, zero_block); + + susp_took(s1_cnt, togo); + snd_list->block_len = togo; + + /* if other is terminated and sound_types match, collapse */ + /* NOTE: in order to collapse, we need s2 to be generating + * blocks and linking them onto a sound list. This is true + * when the get_next fn is SND_get_next. (A counterexample is + * SND_get_zeros, which returns zero blocks but does not link + * them onto the sound list. + */ + if (0) nyquist_printf("s2 %p thissr %g suspsr %g get_next %d lsc %d\n", + susp->s2, susp->s1->sr, susp->susp.sr, + susp->s1->get_next == SND_get_next, + susp->s1->logical_stop_cnt == UNKNOWN); + if (susp->s2 == NULL && susp->s1->sr == susp->susp.sr && + susp->s1->get_next == SND_get_next && + susp->s1->logical_stop_cnt == UNKNOWN) { + snd_list_type addend_list; +D nyquist_printf("add[%p,%p]: collapsing! LSC %d\n", susp->s1, susp->s2, + (int)susp->s1->logical_stop_cnt); +D sound_print_tree(susp->s1); + /* will "current" values match? */ + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } + else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } + /* free the superfluous sound_type and susp */ + addend_list = susp->s1->list->u.next; + snd_list_ref(addend_list); + snd_list_unref(snd_list->u.next); + snd_list->u.next = addend_list; + return; + } + } else { + /* + * we want to copy a partial block + */ + + /* assume the snd_list is the one with a null block */ + /* + * put a fresh, clean block in the snd_list + * (get new snd_list later) + */ + falloc_sample_block(out, "add_s1_nn_fetch"); + snd_list->block = out; + out_ptr = out->samples; +B nyquist_printf("add[%p,%p] (s1_nn) %p new block %p, s1_ptr %p block %p s1_cnt %d togo %d\n", susp->s1, susp->s2, susp, out, susp->s1_ptr, susp->s1_bptr->samples, (int)susp->s1_cnt, togo); + n = togo; +B if (togo == 0) stdputstr("togo is zero at checkpoint 5\n"); +B if (togo == 0) nyquist_printf( + "add[%p,%p] (s%d_nn) %p starting copy loop, togo %d\n", + susp->s1, susp->s2, 1, susp, togo); + while (n--) { /* the inner sample computation loop */ + /* scale? */ + *out_ptr++ = *(susp->s1_ptr++); + } /* inner loop */ + + susp_took(s1_cnt, togo); + snd_list->block_len = togo; + } + + /* add a new snd_list for the susp */ + susp->susp.current += togo; + +D stdputstr("testing..."); + /* + * test for termination or change of state, + * note s2_start computed earlier + */ + if (susp->s2 && susp->susp.current == s2_start && + susp->s1->list != zero_snd_list) { + /* s2 starting and s1 continues */ + /* go to s1+s2 state */ + susp->susp.fetch = add_s1_s2_nn_fetch; +D stdputstr("add_s_nn_fetch: add_s1_s2_fetch installed\n"); + } else if (susp->terminate_bits == 3) { + /* s2 finished and s1 stops */ + /* go to terminal state */ + susp->s1 = NULL; +D nyquist_printf("add_s_nn_fetch: go to terminal state. susp->s2 %p, \ + susp->susp.current %d, s2_start %d, susp->s1->list %p, \ + zero_snd_list %p\n", susp->s2, (int)susp->susp.current, + s2_start, susp->s1->list, zero_snd_list); + /* !!! free resources and set up pointers to terminal snd_list */ + /* !!! logically stopped? */ + } + + /* test for logical stop */ + if (susp->logically_stopped) { +D stdputstr("add_s_nn_fetch: snd_list->logically_stopped\n"); + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current && + susp->logical_stop_bits == 3) { +D stdputstr("add_s_nn_fetch: susp->logically_stopped\n"); + susp->logically_stopped = true; + } +D { + if (susp->logically_stopped || snd_list->logically_stopped) + stdputstr("STOPPED\n"); + else nyquist_printf("ok: current %d\n", (int)susp->susp.current); } +} + + +void add_s2_nn_fetch(susp, snd_list) + register add_susp_type susp; + snd_list_type snd_list; +{ + int togo, s1_start=0; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + +D nyquist_printf("add_s2_nn_fetch(susp %p, snd_list %p)\n", + susp, snd_list); + +#ifdef GC_DEBUG + snd_list_report(snd_list, "add_s2_nn_fetch"); +#endif + + /* + * first compute how many samples to copy (or transfer) + */ + + /* see what the next samples look like */ + susp_check_term_log_block_samples(s2, s2_bptr, + s2_ptr, s2_cnt, 2, 3); + + /* don't run past the s2 input sample block: */ + togo = susp->s2_cnt; + assert(togo > 0); + + /* don't run past terminate time of this signal */ + /* if (susp->s2_ptr == zero_block->samples) { -sep21 RBD*/ + if (susp->terminate_bits & 2) { + if (susp->s1) { + s1_start = ROUND((susp->s1->t0 - susp->susp.t0) * + susp->s1->sr); + if (0) nyquist_printf("add_s_nn_fetch: s1_start %d\n", s1_start); + } + togo = 0; + if (susp->s1 && susp->susp.current == s1_start) { + /* s1 starting and s2 stops */ + /* go to s1 alone state */ + sound_unref(susp->s2); + susp->s2 = NULL; + susp->susp.fetch = add_s1_nn_fetch; +D stdputstr("add_s_nn_fetch: other installed, calling now...\n"); + add_s1_nn_fetch(susp, snd_list); + } else if (susp->s1 && susp->susp.current < s1_start) { + /* s1 not started and s2 stops */ + /* go to zero-fill state */ + sound_unref(susp->s2); + susp->s2 = NULL; + susp->susp.fetch = add_zero_fill_nn_fetch; +D stdputstr("add_s_nn_fetch: zero_fill installed\n"); + add_zero_fill_nn_fetch(susp, snd_list); + } else if (susp->s1) { +D stdputstr("add_s_nn_fetch: unexpected condition\n"); + EXIT(1); + } else /* no s1 */ { + snd_list_terminate(snd_list); + } +D nyquist_printf("add_s_nn_fetch: special return, susp %p\n", susp); + return; /* fetching taken care of by another routine */ + } +/* if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + togo) { + togo = susp->terminate_cnt - susp->susp.current; + } + */ + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN && + /* check if we've seen the logical stop from s2. If so then + log_stop_cnt is max of s1 and s2 stop times */ + (susp->logical_stop_bits & 2)) { + int to_stop; +D nyquist_printf("add_s2_nn_fetch: susp->susp.log_stop_cnt %d\n", + susp->susp.log_stop_cnt); +D nyquist_printf("add_s2_nn_fetch: susp->susp.current %d\n", + susp->susp.current); + to_stop = susp->susp.log_stop_cnt - susp->susp.current; + // to_stop can be less than zero if we've been adding in sounds with + // t0 less than the time when the sound is added. E.g. if the user + // wants a sequence of two sounds that start at 0, the second sound + // will be spliced onto the first because we don't look at it until + // the first finishes -- we cannot go back in time and start adding + // from time 0. This creates a mismatch between the sample count and + // the logical time, so we could actually set a logical stop time that + // is back in history, and therefore before susp.current, resulting + // in a negative to_stop. The problem is really with trying to + // sequence two sounds rather than two behaviors, and a warning has + // already been issued, so we'll just try not to crash here. It's too + // late to compute the correct answer, which would respect t0 of both + // sounds. + if (to_stop < 0) to_stop = 0; + if (to_stop < togo) { + if (to_stop == 0) { + susp->logically_stopped = true; + } else togo = to_stop; + } +B if (togo == 0) stdputstr("togo is zero at checkpoint 3\n"); +D nyquist_printf("add_s2_nn_fetch: to_stop %d togo %d\n", to_stop, togo); + } + + /* consider other signal? don't run past its start time... */ + if (susp->s1) { + s1_start = ROUND((susp->s1->t0 - susp->susp.t0) * + susp->s1->sr); + if (s1_start < susp->susp.current + togo) + togo = MIN(togo, s1_start - susp->susp.current); + assert(togo > 0); + } + + /* + * two cases: copy a partial block or manipulate pointers for + * copyless transfer of whole block (may not be full block): + * + * copy partial block when: + * o samples begin in middle of block + * o stopping time is before end of block (when other signal + * splits the block for this signal) + * transfer (copyless) block when: + * o the block is of maximum size + * o the block is small due to logical stop time or termination + * time + */ + if (susp->s2_ptr == susp->s2_bptr->samples && + susp->s2_cnt == togo) { + /* + * we want to copy this whole block (starting at the beginning + * and going to the rest of the block) -- just do pointers. + */ + + /* just fetch and pass blocks on */ +D nyquist_printf("add[%p,%p] (s%d_nn) %p starting uncopy, togo %d\n", susp->s2, susp->s1, + 2, susp, togo); + snd_list->block = susp->s2_bptr; + (susp->s2_bptr->refcnt)++; +D nyquist_printf("add[%p,%p] (s%d_nn) %p shared block %p zero_block %p\n",susp->s2, susp->s1, + 2, susp, susp->s2_bptr, zero_block); + + susp_took(s2_cnt, togo); + snd_list->block_len = togo; + + /* if other is terminated and sound_types match, collapse */ + /* NOTE: in order to collapse, we need s1 to be generating + * blocks and linking them onto a sound list. This is true + * when the get_next fn is SND_get_next. (A counterexample is + * SND_get_zeros, which returns zero blocks but does not link + * them onto the sound list. + */ + if (0) nyquist_printf("s1 %p thissr %g suspsr %g get_next %d lsc %d\n", + susp->s1, susp->s2->sr, susp->susp.sr, + susp->s2->get_next == SND_get_next, + susp->s2->logical_stop_cnt == UNKNOWN); + if (susp->s1 == NULL && susp->s2->sr == susp->susp.sr && + susp->s2->get_next == SND_get_next && + susp->s2->logical_stop_cnt == UNKNOWN) { + snd_list_type addend_list; +D nyquist_printf("add[%p,%p]: collapsing! LSC %d\n", + susp->s2, susp->s1, (int)susp->s2->logical_stop_cnt); +D sound_print_tree(susp->s2); + /* will "current" values match? */ + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } + else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } + /* free the superfluous sound_type and susp */ + addend_list = susp->s2->list->u.next; + snd_list_ref(addend_list); + snd_list_unref(snd_list->u.next); + snd_list->u.next = addend_list; + return; + } + } else { + /* + * we want to copy a partial block + */ + + /* assume the snd_list is the one with a null block */ + /* + * put a fresh, clean block in the snd_list + * (get new snd_list later) + */ + falloc_sample_block(out, "add_s2_nn_fetch"); + snd_list->block = out; + out_ptr = out->samples; +B nyquist_printf("add[%p,%p] (s2_nn) %p new block %p\n", + susp->s2, susp->s1, susp, out); + n = togo; + if (n == 0) + stdputstr("zero block length error in add_s2_nn_fetch\n"); + assert(n > 0); +B nyquist_printf( + "add[%p,%p] (s2_nn) %p starting copy loop, togo %d\n", + susp->s2, susp->s1, susp, togo); + while (n--) { /* the inner sample computation loop */ + /* scale? */ + *out_ptr++ = *(susp->s2_ptr++); + } /* inner loop */ + + susp_took(s2_cnt, togo); + snd_list->block_len = togo; + } + + /* add a new snd_list for the susp */ + susp->susp.current += togo; + + if (0) stdputstr("testing..."); + /* + * test for termination or change of state, + * note s1_start computed earlier + */ + if (susp->s1 && susp->susp.current == s1_start && + susp->s2->list != zero_snd_list) { + /* s1 starting and s2 continues */ + /* go to s1+s2 state */ + susp->susp.fetch = add_s1_s2_nn_fetch; +D stdputstr("add_s_nn_fetch: add_s1_s2_fetch installed\n"); + } +/* else if (!susp->s1 && susp->s2->list == zero_snd_list) { */ + else if (susp->terminate_bits == 3) { + /* s1 finished and s2 stops */ + /* go to terminal state */ + susp->s2 = NULL; +D nyquist_printf("add_s_nn_fetch: go to terminal state. susp->s1 %p, \ + susp->susp.current %d, s1_start %d, susp->s2->list %p, \ + zero_snd_list %p\n", susp->s1, (int)susp->susp.current, + s1_start, susp->s2->list, zero_snd_list); + /* !!! free resources and set up pointers to terminal snd_list */ + /* !!! logically stopped? */ + } + + /* test for logical stop */ + if (susp->logically_stopped) { +D stdputstr("add_s_nn_fetch: snd_list->logically_stopped\n"); + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current && + (susp->logical_stop_bits & 2)) { +D stdputstr("add_s_nn_fetch: susp->logically_stopped\n"); + susp->logically_stopped = true; + } + if (0) { + if (susp->logically_stopped || snd_list->logically_stopped) + stdputstr("STOPPED\n"); + else + nyquist_printf("ok: current %d\n", (int)susp->susp.current); + } +} + + + +void add_zero_fill_nn_fetch(susp, snd_list) + register add_susp_type susp; + snd_list_type snd_list; +{ + int togo, s_start=0; + +#ifdef GC_DEBUG + snd_list_report(snd_list, "add_zero_fill_nn_fetch"); +#endif + togo = max_sample_block_len; + + if (0) fprintf(STDERR, "add_zero_fill_nn_fetch, susp.current %d\n", + (int)susp->susp.current); + /* don't run past start time ... */ + if (susp->s1) { + s_start = ROUND((susp->s1->t0 - susp->susp.t0) * susp->s1->sr); + if (s_start < susp->susp.current + togo) { + togo = s_start - susp->susp.current; + } + } else if (susp->s2) { + s_start = ROUND((susp->s2->t0 - susp->susp.t0) * susp->s2->sr); + if (s_start < susp->susp.current + togo) { + togo = s_start - susp->susp.current; + } + } + + snd_list->block_len = togo; + susp->susp.current += togo; + /* + * test for change of state, + * note s_start computed earlier + */ + if (susp->s1 && susp->susp.current == s_start) { + /* s1 starting, go to s1 state */ + susp->susp.fetch = add_s1_nn_fetch; +D stdputstr("add_zero_fill_nn_fetch: add_s1_nn_fetch installed\n"); + } else if (susp->s2 && susp->susp.current == s_start) { + /* s2 starting, go to s2 state */ + susp->susp.fetch = add_s2_nn_fetch; +D stdputstr("add_zero_fill_nn_fetch: add_s2_nn_fetch installed\n"); + } +} /* add_zero_fill_nn_fetch */ + + +void add_free(add_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->s2); + ffree_generic(susp, sizeof(add_susp_node), "add_free"); +} + + +void add_mark(add_susp_type susp) +{ +/* nyquist_printf("add_mark(%p)\n", susp);*/ +/* nyquist_printf("marking s1@%p in add@%p\n", susp->s1, susp);*/ + sound_xlmark(susp->s1); +/* nyquist_printf("marking s2@%p in add@%p\n", susp->s2, susp);*/ + sound_xlmark(susp->s2); + +} + + +void add_print_tree(add_susp_type susp, int n) +{ + indent(n); + nyquist_printf("logically_stopped %d logical_stop_bits %d terminate_bits %d\n", + susp->logically_stopped, susp->logical_stop_bits, susp->terminate_bits); + indent(n); + stdputstr("s1:"); + if (susp->s1) sound_print_tree_1(susp->s1, n); + else stdputstr(" NULL\n"); + + indent(n); + stdputstr("s2:"); + if (susp->s2) sound_print_tree_1(susp->s2, n); + else stdputstr(" NULL\n"); +} + + +sound_type snd_make_add(s1, s2) + sound_type s1; + sound_type s2; +{ + register add_susp_type susp; + rate_type sr = MAX(s1->sr, s2->sr); + time_type t0 = MIN(s1->t0, s2->t0); + int interp_desc = 0; + double sample_offset; + + /* sort commutative signals: (S1 S2) */ + snd_sort_2(&s1, &s2, sr); + + falloc_generic(susp, add_susp_node, "snd_make_add"); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_style(s1, sr) << 2) + interp_style(s2, sr); + switch (interp_desc) { + case INTERP_nn: + case INTERP_ns: + case INTERP_ss: + /* eliminate scale factor on s1 if any */ + if (((interp_desc >> INTERP_SHIFT) & INTERP_MASK) == INTERP_s) { + /* stdputstr("add: prescaling s1\n");*/ + s1 = snd_make_normalize(s1); + } + /* eliminate scale factor on s2 if any */ + if ((interp_desc & INTERP_MASK) == INTERP_s) { + /* stdputstr("add: prescaling s2\n"); */ + s2 = snd_make_normalize(s2); + } + sample_offset = (s2->t0 - s1->t0) * sr; + if (sample_offset >= 0.5) { /* s1 starts first */ + susp->susp.fetch = add_s1_nn_fetch; +D stdputstr("snd_make_add: add_s1_nn_fetch installed\n"); + } else if (sample_offset < -0.5) { /* s2 starts first */ + susp->susp.fetch = add_s2_nn_fetch; +D stdputstr("snd_make_add: add_s2_nn_fetch installed\n"); + } else { /* equal start times */ + susp->susp.fetch = add_s1_s2_nn_fetch; +D stdputstr("snd_make_add: add_s1_s2_nn_fetch installed\n"); + } + break; + case INTERP_ni: + case INTERP_nr: + errputstr("add: can't interpolate!\n"); + EXIT(1); + default: + errputstr("add: can't add these operands!\n"); + EXIT(1); + } + + susp->terminate_cnt = UNKNOWN; + susp->terminate_bits = 0; /* bits for s1 and s2 termination */ + susp->logical_stop_bits = 0; /* bits for s1 and s2 logical stop */ + + /* initialize susp state */ + susp->susp.free = add_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = add_mark; + susp->susp.print_tree = add_print_tree; + susp->susp.name = "add"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = UNKNOWN; + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->s2 = s2; + susp->s2_cnt = 0; +#ifdef UPSAMPLECODE + susp->susp.s2_phase = 0.0; + susp->susp.s2_phase_incr = s2->sr / sr; + susp->susp.output_per_s2 = sr / s2->sr; +#endif + return sound_create((snd_susp_type)susp, t0, sr, 1.0); +} + + +sound_type snd_add(s1, s2, t0) + sound_type s1; + sound_type s2; + time_type t0; +{ + sound_type s1_copy = sound_copy(s1); + sound_type s2_copy = sound_copy(s2); +/* nyquist_printf("snd_add %p %p copied to %p %p\n", s1, s2, s1_copy, s2_copy); */ + return snd_make_add(s1_copy, s2_copy, t0); +} diff --git a/nyqsrc/add.h b/nyqsrc/add.h new file mode 100644 index 0000000..e1835ac --- /dev/null +++ b/nyqsrc/add.h @@ -0,0 +1,44 @@ +/* this typedef goes here because it is needed by multiseq.c */ + +typedef struct add_susp_struct { + snd_susp_node susp; + boolean started; + int terminate_bits; + long terminate_cnt; + int logical_stop_bits; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_type s1_bptr; /* block pointer */ + sample_block_values_type s1_ptr; + sound_type s2; + long s2_cnt; + sample_block_type s2_bptr; /* block pointer */ + sample_block_values_type s2_ptr; + +#ifdef UPSAMPLECODE + /* support for interpolation of s2 */ + sample_type s2_x1_sample; + double s2_phase; + double s2_phase_incr; + + /* support for ramp between samples of s2 */ + double output_per_s2; +#endif + /* pointer used to synchronize adds in multiseq */ + struct multiseq_struct *multiseq; + long s1_prepend; /* offset to susp.current */ +} add_susp_node, *add_susp_type; + +sound_type snd_make_add(); +sound_type snd_add(); + /* LISP: (SND-ADD SOUND SOUND) */ + +/* we export these for seq.c and multiseq.c */ +void add_zero_fill_nn_fetch(add_susp_type susp, snd_list_type snd_list); +void add_s1_s2_nn_fetch(add_susp_type susp, snd_list_type snd_list); +void add_s2_nn_fetch(add_susp_type susp, snd_list_type snd_list); +void add_s1_nn_fetch(add_susp_type susp, snd_list_type snd_list); +void add_mark(add_susp_type susp); +void add_print_tree(add_susp_type susp, int n); +void add_free(add_susp_type susp); diff --git a/nyqsrc/avg.c b/nyqsrc/avg.c new file mode 100644 index 0000000..1a08ee1 --- /dev/null +++ b/nyqsrc/avg.c @@ -0,0 +1,273 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "avg.h" + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + + +void avg_free(); + +typedef sample_type (*process_block_type)(/* struct avg_susp_struct *susp */); + +typedef struct avg_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + /* blocksize is how many input samples to process for an output sample */ + long blocksize; + /* stepsize is how far to advance to get the next block of samples */ + long stepsize; + sample_type *buffer; + sample_type *fillptr; /* samples are added to buffer at fillptr */ + sample_type *endptr; /* until endptr is reached */ + process_block_type process_block; +} avg_susp_node, *avg_susp_type; + + +sample_type average_block(avg_susp_type susp) +{ + /* this version just computes average */ + double sum = 0.0; + int i; + for (i = 0; i < susp->blocksize; i++) { + sum += susp->buffer[i]; + } + for (i = susp->stepsize; i < susp->blocksize; i++) { + susp->buffer[i - susp->stepsize] = susp->buffer[i]; + } + return (sample_type) (sum / susp->blocksize); +} + + +sample_type peak_block(avg_susp_type susp) +{ + /* this version just computes average */ + sample_type peak = 0.0F; + sample_type minus_peak = 0.0F; + int i; + for (i = 0; i < susp->blocksize; i++) { + sample_type s = susp->buffer[i]; + if (s > peak) { + peak = s; minus_peak = -s; + } else if (s < minus_peak) { + minus_peak = s; peak = -s; + } + } + for (i = susp->stepsize; i < susp->blocksize; i++) { + susp->buffer[i - susp->stepsize] = susp->buffer[i]; + } + return peak; +} + + +void avg_s_fetch(avg_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + int togo = 0; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_type *fillptr_reg; + register sample_type *endptr_reg = susp->endptr; + + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "avg_s_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = (max_sample_block_len - cnt) * susp->stepsize; + + /* don't run past the s input sample block: */ + susp_check_term_log_samples(s, s_ptr, s_cnt); + togo = MIN(togo, susp->s_cnt); + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo/susp->stepsize) { + togo = (susp->terminate_cnt - (susp->susp.current + cnt)) * susp->stepsize; + if (togo == 0) break; + } + + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + /* break if to_stop == 0 (we're at the logical stop) + * AND cnt > 0 (we're not at the beginning of the + * output block). + */ + if (to_stop < togo/susp->stepsize) { + if (to_stop == 0) { + if (cnt) { + togo = 0; + break; + } else /* keep togo as is: since cnt == 0, we + * can set the logical stop flag on this + * output block + */ + susp->logically_stopped = true; + } else /* limit togo so we can start a new + * block at the LST + */ + togo = to_stop * susp->stepsize; + } + } + + n = togo; + s_ptr_reg = susp->s_ptr; + fillptr_reg = susp->fillptr; + if (n) do { /* the inner sample computation loop */ + *fillptr_reg++ = *s_ptr_reg++; + if (fillptr_reg >= endptr_reg) { + *out_ptr++ = (*(susp->process_block))(susp); + cnt++; + fillptr_reg -= susp->stepsize; + } + } while (--n); /* inner loop */ + + /* using s_ptr_reg is a bad idea on RS/6000: */ + susp->s_ptr += togo; + susp->fillptr = fillptr_reg; + susp_took(s_cnt, togo); + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* avg_s_fetch */ + + +void avg_toss_fetch(susp, snd_list) + avg_susp_type susp; + snd_list_type snd_list; +{ + long final_count = MIN(susp->susp.current + max_sample_block_len, + susp->susp.toss_cnt); + time_type final_time = susp->susp.t0 + final_count / susp->susp.sr; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while (((long) ((final_time - susp->s->t0) * susp->s->sr + 0.5)) >= + susp->s->current) + susp_get_samples(s, s_ptr, s_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + if (final_count == susp->susp.toss_cnt) { + n = ROUND((final_time - susp->s->t0) * susp->s->sr - + (susp->s->current - susp->s_cnt)); + susp->s_ptr += n; + susp_took(s_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + } + snd_list->block_len = (short) (final_count - susp->susp.current); + susp->susp.current = final_count; + snd_list->u.next = snd_list_create((snd_susp_type) susp); + snd_list->block = internal_zero_block; +} + + +void avg_mark(avg_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void avg_free(avg_susp_type susp) +{ + sound_unref(susp->s); + free(susp->buffer); + ffree_generic(susp, sizeof(avg_susp_node), "avg_free"); +} + + +void avg_print_tree(avg_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_avg(sound_type s, long blocksize, long stepsize, long op) +{ + long buffersize; + register avg_susp_type susp; + rate_type sr = s->sr; + time_type t0 = s->t0; + time_type t0_min = t0; + + falloc_generic(susp, avg_susp_node, "snd_make_avg"); + susp->susp.fetch = avg_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s->t0) sound_prepend_zeros(s, t0); + /* minimum start time over all inputs: */ + t0_min = MIN(s->t0, t0); + /* how many samples to toss before t0: */ + susp->susp.toss_cnt = ROUND((t0 - t0_min) * sr); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = avg_toss_fetch; + t0 = t0_min; + } + + /* initialize susp state */ + susp->susp.free = avg_free; + susp->susp.sr = sr / stepsize; + susp->susp.t0 = t0; + susp->susp.mark = avg_mark; + susp->susp.print_tree = avg_print_tree; + susp->susp.name = "avg"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s); + susp->susp.current = 0; + susp->s = s; + susp->s_cnt = 0; + susp->blocksize = blocksize; + susp->stepsize = stepsize; + /* We need at least blocksize samples in buffer, but if stepsize > blocksize, + it is convenient to put stepsize samples in buffer. This allows us to + step ahead by stepsize samples just by flushing the buffer. */ + buffersize = MAX(blocksize, stepsize); + susp->buffer = (sample_type *) malloc(buffersize * sizeof(sample_type)); + susp->fillptr = susp->buffer; + susp->endptr = susp->buffer + buffersize; + susp->process_block = average_block; + if (op == op_peak) susp->process_block = peak_block; + /* scale factor gets passed to output signal: */ + return sound_create((snd_susp_type) susp, t0, susp->susp.sr, susp->s->scale); +} + + +sound_type snd_avg(sound_type s, long blocksize, long stepsize, long op) +{ + sound_type s_copy = sound_copy(s); + return snd_make_avg(s_copy, blocksize, stepsize, op); +} diff --git a/nyqsrc/avg.h b/nyqsrc/avg.h new file mode 100644 index 0000000..4c21cc3 --- /dev/null +++ b/nyqsrc/avg.h @@ -0,0 +1,6 @@ +sound_type snd_make_avg(sound_type s, long blocksize, long stepsize, long op); +sound_type snd_avg(sound_type s, long blocksize, long stepsize, long op); + /* LISP: (snd-avg SOUND FIXNUM FIXNUM FIXNUM) */ +#define op_average 1 +#define op_peak 2 +/* LISP-SRC: (setf OP-AVERAGE 1) (setf OP-PEAK 2) */ diff --git a/nyqsrc/compose.c b/nyqsrc/compose.c new file mode 100644 index 0000000..a15fe34 --- /dev/null +++ b/nyqsrc/compose.c @@ -0,0 +1,304 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "compose.h" + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +void compose_free(); + + +typedef struct compose_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type f; + long f_cnt; + sample_block_values_type f_ptr; + sample_type f_prev; + double f_time; + double f_time_increment; + boolean started; + sound_type g; + long g_cnt; + sample_block_values_type g_ptr; +} compose_susp_node, *compose_susp_type; + + +/* compose_fetch -- computes f(g(t)) */ +/**/ +void compose_fetch(register compose_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + int togo = 0; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register sample_block_values_type g_ptr_reg; + register sample_block_values_type f_ptr_reg; + falloc_sample_block(out, "compose_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure we are primed with first value of f */ + /* This is a lot of work just to prefetch susp->f_prev! */ + if (!susp->started) { + susp->started = true; + /* see comments below about susp_check_term_log_samples() */ + if (susp->f_cnt == 0) { + susp_get_samples(f, f_ptr, f_cnt); + if (susp->f_ptr == zero_block->samples) { + susp->terminate_cnt = susp->susp.current; + } + } + susp->f_prev = susp_fetch_sample(f, f_ptr, f_cnt); + susp->f_time += susp->f_time_increment; + } + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = max_sample_block_len - cnt; + + /* don't run past the f input sample block: */ + /* most fetch routines call susp_check_term_log_samples() here + * but we can't becasue susp_check_term_log_samples() assumes + * that output time progresses at the same rate as input time. + * Here, some time warping is going on, so this doesn't work. + * Instead, check for termination of f and fix terminate_cnt to + * be the current output count rather than the current input time. + */ + if (susp->f_cnt == 0) { + susp_get_samples(f, f_ptr, f_cnt); + if (susp->f->logical_stop_cnt == susp->f->current - susp->f_cnt) { + if (susp->susp.log_stop_cnt == UNKNOWN) { + susp->susp.log_stop_cnt = susp->susp.current + cnt; + } + } + if (susp->f_ptr == zero_block->samples) { + susp->terminate_cnt = susp->susp.current + cnt; + /* we can't simply terminate here because we might have + * some output samples computed already, in which case we + * want to return them now and terminate the NEXT time we're + * called. + */ + } + } + +#ifdef CUT + /* don't run past the f input sample block: */ + susp_check_term_log_samples(f, f_ptr, f_cnt); + togo = MIN(togo, susp->f_cnt); +#endif + /* don't run past the g input sample block: */ + susp_check_term_samples(g, g_ptr, g_cnt); + togo = MIN(togo, susp->g_cnt); + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); + if (togo == 0) break; + } + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + if (to_stop < togo && ((togo = to_stop) == 0)) break; + } + + n = togo; + + g_ptr_reg = susp->g_ptr; + f_ptr_reg = susp->f_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double g_of_t = *g_ptr_reg; + #if 0 + float tmp; /* for debugging */ + nyquist_printf("output sample %d, g_of_t %g", susp->susp.current + cnt, g_of_t); + #endif + /* now we scan f and interpolate at time point g_of_t */ + while (susp->f_time < g_of_t) { + susp->f_time += susp->f_time_increment; + susp->f_prev = *f_ptr_reg++; +/* nyquist_printf(", (f_time %g, f %g)", susp->f_time, *f_ptr_reg); */ + susp->f_ptr++; + susp->f_cnt--; + if (susp->f_cnt == 0) { + togo -= n; +/* stdputstr("\n\tf out of samples...\n"); */ + goto f_out_of_samples; + } + } + g_ptr_reg++; + *out_ptr_reg++ /* = tmp */ = + (sample_type) (*f_ptr_reg - (*f_ptr_reg - susp->f_prev) * + (susp->f_time - g_of_t) * susp->f->sr); +/* nyquist_printf(", output %g\n", tmp);*/ + } while (--n); /* inner loop */ +f_out_of_samples: + /* using g_ptr_reg is a bad idea on RS/6000: */ + susp->g_ptr += togo; + out_ptr += togo; + susp_took(g_cnt, togo); + cnt += togo; + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* compose_fetch */ + + +void compose_toss_fetch(susp, snd_list) + register compose_susp_type susp; + snd_list_type snd_list; +{ + long final_count = MIN(susp->susp.current + max_sample_block_len, + susp->susp.toss_cnt); + time_type final_time = susp->susp.t0 + final_count / susp->susp.sr; + long n; + + /* fetch samples from f up to final_time for this block of zeros */ + while (((long) ((final_time - susp->f->t0) * susp->f->sr + 0.5)) >= + susp->f->current) + susp_get_samples(f, f_ptr, f_cnt); + /* fetch samples from g up to final_time for this block of zeros */ + while (((long) ((final_time - susp->g->t0) * susp->g->sr + 0.5)) >= + susp->g->current) + susp_get_samples(g, g_ptr, g_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + if (final_count == susp->susp.toss_cnt) { + n = ROUND((final_time - susp->f->t0) * susp->f->sr - + (susp->f->current - susp->f_cnt)); + susp->f_ptr += n; + susp_took(f_cnt, n); + n = ROUND((final_time - susp->g->t0) * susp->g->sr - + (susp->g->current - susp->g_cnt)); + susp->g_ptr += n; + susp_took(g_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + } + snd_list->block_len = (short) (final_count - susp->susp.current); + susp->susp.current = final_count; + snd_list->u.next = snd_list_create((snd_susp_type) susp); + snd_list->block = internal_zero_block; +} + + +void compose_mark(compose_susp_type susp) +{ + sound_xlmark(susp->f); + sound_xlmark(susp->g); +} + + +void compose_free(compose_susp_type susp) +{ + sound_unref(susp->f); + sound_unref(susp->g); + ffree_generic(susp, sizeof(compose_susp_node), "compose_free"); +} + + +void compose_print_tree(compose_susp_type susp, int n) +{ + indent(n); + stdputstr("f:"); + sound_print_tree_1(susp->f, n); + + indent(n); + stdputstr("g:"); + sound_print_tree_1(susp->g, n); +} + + +sound_type snd_make_compose(sound_type f, sound_type g) +{ + register compose_susp_type susp; + rate_type sr = g->sr; + time_type t0 = g->t0; + + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + + /* combine scale factors of linear inputs (S1 S2) */ + scale_factor *= f->scale; + f->scale = 1.0F; + + /* scale factor in g effectively scales sample rate of f: */ + f->sr *= g->scale; +/* BUG */ + /* probably need to correct f->t0, but I don't understand this, + so I'll leave this until we have some test cases */ + + falloc_generic(susp, compose_susp_node, "snd_make_compose"); + susp->susp.fetch = compose_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ +/* BUG: do we need to prepend to f? + if (t0 < f->t0) sound_prepend_zeros(f, t0); */ + if (t0 < g->t0) sound_prepend_zeros(g, t0); + /* minimum start time over all inputs: */ + t0_min = MIN(g->t0, t0); + /* how many samples to toss before t0: */ + susp->susp.toss_cnt = ROUND((t0 - t0_min) * sr); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = compose_toss_fetch; + t0 = t0_min; + } + + /* initialize susp state */ + susp->susp.free = compose_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = compose_mark; + susp->susp.print_tree = compose_print_tree; + susp->susp.name = "compose"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = f->logical_stop_cnt; + if (susp->susp.log_stop_cnt > g->logical_stop_cnt) + susp->susp.log_stop_cnt = g->logical_stop_cnt; + susp->susp.current = 0; + susp->f = f; + susp->f_cnt = 0; + susp->f_time = 0; + susp->f_time_increment = 1 / f->sr; + susp->g = g; + susp->g_cnt = 0; + susp->started = false; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_compose(sound_type f, sound_type g) +{ + sound_type f_copy = sound_copy(f); + sound_type g_copy = sound_copy(g); + return snd_make_compose(f_copy, g_copy); +} diff --git a/nyqsrc/compose.h b/nyqsrc/compose.h new file mode 100644 index 0000000..efd773c --- /dev/null +++ b/nyqsrc/compose.h @@ -0,0 +1,3 @@ +sound_type snd_make_compose(sound_type f, sound_type g); +sound_type snd_compose(sound_type f, sound_type g); + /* LISP: (snd-compose SOUND SOUND) */ diff --git a/nyqsrc/convolve.c b/nyqsrc/convolve.c new file mode 100644 index 0000000..79d94dd --- /dev/null +++ b/nyqsrc/convolve.c @@ -0,0 +1,329 @@ +/* convolve.c -- implements (non-"fast") convolution */ +/* + * Note: this code is mostly generated by translate.lsp (see convole.tran + * in the tran directory), but it has been modified by hand to extend the + * stop time to include the "tail" of the convolution beyond the length + * of the first parameter. + */ + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "convolve.h" + +void convolve_free(); + + +typedef struct convolve_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type x_snd; + long x_snd_cnt; + sample_block_values_type x_snd_ptr; + + table_type table; + sample_type *h_buf; + double length_of_h; + long h_len; + long x_buf_len; + sample_type *x_buffer_pointer; + sample_type *x_buffer_current; +} convolve_susp_node, *convolve_susp_type; + + +void h_reverse(sample_type *h, long len) +{ + sample_type temp; + int i; + + for (i = 0; i < len; i++) { + temp = h[i]; + h[i] = h[len - 1]; + h[len - 1] = temp; + len--; + } +} + + +void convolve_s_fetch(register convolve_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + int togo; + int n, i; + int round; + int ready = 0; + float* Utb1; + short* BRLow; + long M; + + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register sample_type * h_buf_reg; + register long h_len_reg; + register long x_buf_len_reg; + register sample_type * x_buffer_pointer_reg; + register sample_type * x_buffer_current_reg; + register sample_type x_snd_scale_reg = susp->x_snd->scale; + register sample_block_values_type x_snd_ptr_reg; + + sample_type* Yk; + sample_type* y_output_buffer; + sample_type* x_input_buffer; + + falloc_sample_block(out, "convolve_s_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = max_sample_block_len - cnt; + + /* don't run past the x_snd input sample block: */ + /* based on susp_check_term_log_samples, but offset by h_len */ + + /* THIS IS EXPANDED BELOW + * susp_check_term_log_samples(x_snd, x_snd_ptr, x_snd_cnt); + */ + if (susp->x_snd_cnt == 0) { + susp_get_samples(x_snd, x_snd_ptr, x_snd_cnt); + + /* THIS IS EXPANDED BELOW + *logical_stop_test(x_snd, susp->x_snd_cnt); + */ + if (susp->x_snd->logical_stop_cnt == + susp->x_snd->current - susp->x_snd_cnt) { + min_cnt(&susp->susp.log_stop_cnt, susp->x_snd, + (snd_susp_type) susp, susp->x_snd_cnt); + } + + /* THIS IS EXPANDED BELOW + * terminate_test(x_snd_ptr, x_snd, susp->x_snd_cnt); + */ + if (susp->x_snd_ptr == zero_block->samples) { + /* ### modify this to terminate at an offset of (susp->h_len) */ + /* Note: in the min_cnt function, susp->x_snd_cnt is *subtracted* + * from susp->x_snd->current to form the terminate time, so to + * increase the time, we need to *subtract* susp->h_len, which + * due to the double negative, *adds* susp->h_len to the ultimate + * terminate time calculation. + */ + min_cnt(&susp->terminate_cnt, susp->x_snd, + (snd_susp_type) susp, susp->x_snd_cnt - susp->h_len); + } + } + + + togo = min(togo, susp->x_snd_cnt); + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); + if (togo == 0) break; + } + + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + /* break if to_stop == 0 (we're at the logical stop) + * AND cnt > 0 (we're not at the beginning of the + * output block). + */ + if (to_stop < togo) { + if (to_stop == 0) { + if (cnt) { + togo = 0; + break; + } else /* keep togo as is: since cnt == 0, we + * can set the logical stop flag on this + * output block + */ + susp->logically_stopped = true; + } else /* limit togo so we can start a new + * block at the LST + */ + togo = to_stop; + } + } + + n = togo; + h_buf_reg = susp->h_buf; + h_len_reg = susp->h_len; + x_buf_len_reg = susp->x_buf_len; + x_buffer_pointer_reg = susp->x_buffer_pointer; + x_buffer_current_reg = susp->x_buffer_current; + x_snd_ptr_reg = susp->x_snd_ptr; + out_ptr_reg = out_ptr; + + //buffer's length is twice the h_len because convolution yields 2N-1 + y_output_buffer[2 * (int)h_len_reg]; + x_input_buffer[2 * (int)h_len_reg]; + memset(y_output_buffer, (sample_type)0.0f, 2 * h_len_reg * sizeof(sample_type)); + memset(x_input_buffer, (sample_type)0.0f, 2 * h_len_reg * sizeof(sample_type)); + + M = log(h_len_reg) / log(2); + round = (int)M; + if((long)round != M) + round++; + + fftCosInit(round, Utb1); + fftBRInit(round, BRLow); + + ffts1(h_buf_reg, round, 1.0, Utb1, BRLow); + if (n) do { /* the inner sample computation loop */ + if(ready <= 0){ + //shift output buffer + for(i = 0; i < x_buf_len_reg; i++){ + y_output_buffer[i] = y_output_buffer[i+h_len_reg]; + y_output_buffer[i+h_len_reg] = 0.0f; + } + + ffts1(x_input_buffer, round, 1L, Utb1, BRLow); + //multiply + for(i = 0; i < 2 * h_len_reg; i++) + Yk[i] = x_input_buffer[i] * h_buf_reg[i]; + + iffts1(Yk, round, 1.0, Utb1, BRLow); + //overlap add + for(i = 0; i < 2 * h_len_reg; i++) + y_output_buffer[i] += Yk[i]; + + ready = h_len_reg; + } + //ready describes the reciprocal of location in the input/output buffer + x_input_buffer[h_len_reg - ready] = x_snd_scale_reg * *x_snd_ptr_reg++; + *out_ptr_reg++ = y_output_buffer[h_len_reg - ready]; + ready--; + } while (--n); /* inner loop */ + + susp->x_buffer_pointer = x_buffer_pointer_reg; + susp->x_buffer_current = x_buffer_current_reg; + /* using x_snd_ptr_reg is a bad idea on RS/6000: */ + susp->x_snd_ptr += togo; + out_ptr += togo; + susp_took(x_snd_cnt, togo); + cnt += togo; + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* convolve_s_fetch */ + + +void convolve_toss_fetch(susp, snd_list) + register convolve_susp_type susp; + snd_list_type snd_list; +{ + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from x_snd up to final_time for this block of zeros */ + while ((round((final_time - susp->x_snd->t0) * susp->x_snd->sr)) >= + susp->x_snd->current) + susp_get_samples(x_snd, x_snd_ptr, x_snd_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->x_snd->t0) * susp->x_snd->sr - + (susp->x_snd->current - susp->x_snd_cnt)); + susp->x_snd_ptr += n; + susp_took(x_snd_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void convolve_mark(convolve_susp_type susp) +{ + sound_xlmark(susp->x_snd); +} + + +void convolve_free(convolve_susp_type susp) +{ + table_unref(susp->table); + free(susp->x_buffer_pointer); sound_unref(susp->x_snd); + ffree_generic(susp, sizeof(convolve_susp_node), "convolve_free"); +} + + +void convolve_print_tree(convolve_susp_type susp, int n) +{ + indent(n); + stdputstr("x_snd:"); + sound_print_tree_1(susp->x_snd, n); +} + + +sound_type snd_make_convolve(sound_type x_snd, sound_type h_snd) +{ + register convolve_susp_type susp; + rate_type sr = x_snd->sr; + time_type t0 = x_snd->t0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, convolve_susp_node, "snd_make_convolve"); + susp->table = sound_to_table(h_snd); + susp->h_buf = susp->table->samples; + susp->length_of_h = susp->table->length; + susp->h_len = (long) susp->length_of_h; + h_reverse(susp->h_buf, susp->h_len); + susp->x_buf_len = 2 * susp->h_len; + susp->x_buffer_pointer = calloc((2 * (susp->h_len)), sizeof(float)); + susp->x_buffer_current = susp->x_buffer_pointer; + susp->susp.fetch = convolve_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < x_snd->t0) sound_prepend_zeros(x_snd, t0); + /* minimum start time over all inputs: */ + t0_min = min(x_snd->t0, t0); + /* how many samples to toss before t0: */ + susp->susp.toss_cnt = (long) ((t0 - t0_min) * sr + 0.5); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = convolve_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = convolve_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = convolve_mark; + susp->susp.print_tree = convolve_print_tree; + susp->susp.name = "convolve"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(x_snd); + susp->susp.current = 0; + susp->x_snd = x_snd; + susp->x_snd_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_convolve(sound_type x_snd, sound_type h_snd) +{ + sound_type x_snd_copy = sound_copy(x_snd); + return snd_make_convolve(x_snd_copy, h_snd); +} diff --git a/nyqsrc/convolve.h b/nyqsrc/convolve.h new file mode 100644 index 0000000..27eac33 --- /dev/null +++ b/nyqsrc/convolve.h @@ -0,0 +1,3 @@ +sound_type snd_make_convolve(sound_type x_snd, sound_type h_snd); +sound_type snd_convolve(sound_type x_snd, sound_type h_snd); + /* LISP: (snd-convolve SOUND SOUND) */ diff --git a/nyqsrc/cque.h b/nyqsrc/cque.h new file mode 100644 index 0000000..e001e3c --- /dev/null +++ b/nyqsrc/cque.h @@ -0,0 +1,25 @@ +/* + * cque.h + * macros for free lists. + */ + +typedef struct cque { + struct cque *qnext; +} CQUE; + +#define Qinit(q1) { (q1) = 0; } + +/* q1 points to a stack CQUE*, new is an element to insert */ +#define Qenter(q1,new) { \ + ((CQUE *)(new))->qnext = ((CQUE *)(q1)); \ + q1 = ((CQUE *)(new)); } + + +/* q1 points to a list of CQUE*: remove elt and assign to new */ +/* NOTE: q1 must be non-empty */ +#define Qget(q1,newtype,new) { \ + (new) = (newtype)(q1); \ + q1 = ((CQUE *)(q1))->qnext; } + + +#define Qempty(q1) ((q1) == 0) diff --git a/nyqsrc/debug.c b/nyqsrc/debug.c new file mode 100644 index 0000000..74a77f5 --- /dev/null +++ b/nyqsrc/debug.c @@ -0,0 +1,249 @@ +#include <stdio.h> +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "debug.h" + +/* The DEBUG_MEM related routines are: + * dbg_mem_allocated: called when memory is allocated + * dbg_mem_freed: called when memory is freed + * dbg_mem_released: called when memory is released + */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + + +#if DEBUG_MEM +typedef struct { + long seq_num; + char *who; +} dbg_mem_node, *dbg_mem_type; + +static long dbg_mem_last_seq_num = 0; +long dbg_mem_seq_num = 0; +long dbg_mem_trace = 0x410988; + +void dbg_mem_pause(void) +{ + stdputstr("RETURN to continue: "); + getchar(); +} + + +void dbg_mem_allocated(void *p, char *who) +{ + dbg_mem_type info = (dbg_mem_type) p; + if (p == (void *) dbg_mem_trace) { + nyquist_printf("dbg_mem_allocated(%p, %s)\n", p, who); + } + info--; /* info is stored (hidden) BEFORE the data */ + dbg_mem_last_seq_num++; + if (dbg_mem_last_seq_num == dbg_mem_seq_num) { + nyquist_printf("dbg_mem_allocated: " + "%s just allocated %p as number %d\n", + who, p, (int)dbg_mem_last_seq_num); + dbg_mem_pause(); + } + info->seq_num = dbg_mem_last_seq_num; + info->who = who; +} + + +void dbg_mem_freed(void *p, char *who) +{ + dbg_mem_type info = (dbg_mem_type) p; + if (p == (void *) dbg_mem_trace) { + nyquist_printf("dbg_mem_freed(%p, %s)\n", p, who); + } + info--; /* info is stored (hidden) BEFORE the data */ + if (!info->who) { + nyquist_printf("MEMORY %p FREED TWICE!, " + "second time by: %s, seq_num %d\n", + p, who, (int)info->seq_num); + fflush(stdout); + dbg_mem_pause(); + } + if (info->seq_num == dbg_mem_seq_num) { + nyquist_printf("dbg_mem_freed: %s freeing %p, number %d\n", + who, p, (int)dbg_mem_seq_num); + dbg_mem_pause(); + } + info->who = NULL; +} + +void dbg_mem_released(void *p, char *who) +{ + dbg_mem_type info = (dbg_mem_type) p; + if (p == (void *) dbg_mem_trace) { + nyquist_printf("dbg_mem_released(%p, %s)\n", p, who); + } + info--; /* info is stored (hidden) BEFORE the data */ + if (!info->who) { + nyquist_printf("MEMORY %p RELEASED BUT NOT ALLOCATED!, " + "released by: %s, seq_num %d\n", + p, who, (int)info->seq_num); + fflush(stdout); + dbg_mem_pause(); + } + if (info->seq_num == dbg_mem_seq_num) { + nyquist_printf("dbg_mem_released: %s releasing %p, number %d\n", + who, p, (int)dbg_mem_seq_num); + dbg_mem_pause(); + } +} + + +void dbg_mem_check(void *p, char *who) +{ + dbg_mem_type info = (dbg_mem_type) p; + if (!info) { + nyquist_printf("DBG_MEM_CHECK (from %s): NULL POINTER!", who); + fflush(stdout); + dbg_mem_pause(); + } + info--; /* info is stored (hidden) BEFORE the data */ + if (!info->who) { + nyquist_printf("DBG_MEM_CHECK (from %s): %p IS FREE!, seq_num %d\n", + who, p, (int)info->seq_num); + fflush(stdout); + dbg_mem_pause(); + } +} + + +void dbg_mem_print(char *msg, void *p) +{ + dbg_mem_type info = (dbg_mem_type) p; + stdputstr(msg); + if (!info) { + stdputstr(" NULL POINTER"); + } else { + info--; /* info is stored (hidden) BEFORE the data */ + if (!info->who) { + nyquist_printf(" %p IS FREE!, ", p); + } else { + nyquist_printf(" %p allocated by %s, ", p, info->who); + } + nyquist_printf("seq_num %d\n", (int)info->seq_num); + } +} +#endif + + +void print_sound_type(sound_type s) +{ + snd_list_type list; + int blockcount; + + nyquist_printf("sound_type: 0x%p\n", s); + nyquist_printf("\tt0: %f\n", s->t0); + nyquist_printf("\tsr: %f\n", s->sr); + nyquist_printf("\tcurrent: %d\n", (int)s->current); + nyquist_printf("\tlogical_stop_cnt: %d\n", (int)s->logical_stop_cnt); + nyquist_printf("\tlist: 0x%p\n", s->list); + nyquist_printf("\tscale: %f\n", s->scale); + + list = s->list; + blockcount = 0; + nyquist_printf("\t(0x%p:0x%p)->", list, list->block); + while (list->block) { + list = list->u.next; + if (blockcount < 5) { + nyquist_printf("(0x%p:0x%p)->", list, list->block); + } + else if (blockcount == 5) { + stdputstr(" ... "); + break; + } + blockcount++; + } + stdputstr("\n"); +} + +void print_snd_list_type(snd_list_type list) +{ + nyquist_printf("%p: [%p[%d], %p] refcnt %d ls %d", list, list->block, + list->block_len, list->u.next, + list->refcnt, list->logically_stopped); +} + + + +void print_sample_block_type(char *label, + sample_block_type sampblock, + int len) +{ + int j; + sample_block_values_type samp; + + samp = sampblock->samples; + nyquist_printf("%s: [%p(ref %d): len %d]: =========>>", + label, sampblock, (int)sampblock->refcnt, len); + for (j = 0; j < len; j++) { + nyquist_printf("%6g ", *samp++); + } + stdputstr("\n"); +} + + +/*******/ +snd_susp_type susp_to_watch = NULL; + +void watch_susp(snd_susp_type s) +{ + if (!susp_to_watch) { + susp_to_watch = s; + nyquist_printf("watching susp %p\n", s); + } +} + +sound_type sound_to_watch = NULL; + +void watch_sound(sound_type s) +{ + if (!sound_to_watch) { + sound_to_watch = s; + nyquist_printf("watching sound %p\n", s); + } +} + + +snd_list_type snd_list_to_watch = NULL; + +void watch_snd_list(snd_list_type s) +{ + snd_list_to_watch = s; + nyquist_printf("watching snd_list %p\n", s); +} + + +void snd_list_debug(snd_list_type snd_list, char *s) +{ + if (snd_list == snd_list_to_watch) { + nyquist_printf("%s%s\n", s, + " appended to snd_list_to_watch."); + watch_snd_list(snd_list->u.next); + } +} + + +void snd_list_report(snd_list_type snd_list, char *s) +{ + if (snd_list == snd_list_to_watch) { + nyquist_printf("%s: fetching block for watched snd_list.\n", + s); + } +} + + +#ifdef IGNORE +void test_it() +{ + if (susp_to_watch && susp_to_watch->keep_fetch) + stdputstr("WE FOUND A SERIOUS PROBLEM\n"); +} +#endif + diff --git a/nyqsrc/debug.h b/nyqsrc/debug.h new file mode 100644 index 0000000..6874ed2 --- /dev/null +++ b/nyqsrc/debug.h @@ -0,0 +1,47 @@ +#ifndef DEBUG_H + +#ifdef PARTIAL_DECLARATIONS +typedef struct partial_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + long logical_stop_cnt; + boolean logically_stopped; + sound_type env; + long env_cnt; + sample_block_values_type env_ptr; + + /* support for interpolation of env */ + sample_type env_x1_sample; + double env_pHaSe; + double env_pHaSe_iNcR; + + /* support for ramp between samples of env */ + double output_per_env; + long env_n; + + long phase; + long ph_incr; + double max_diff; + double prev_output; +} partial_susp_node, *partial_susp_type; +#endif + +extern sound_type watch_table_sound; +extern int table_ptr_check_enable; + +void print_sound_type(sound_type s); +void print_sample_block_type(char *label, + sample_block_type sampblock, int len); +void watch_susp(snd_susp_type s); +void watch_sound(sound_type s); +void snd_list_debug(snd_list_type snd_list, char *s); +void watch_snd_list(snd_list_type s); +void dbg_mem_allocated(void *p, char *who); +void dbg_mem_freed(void *p, char *who); +void dbg_mem_print(char *msg, void *p); +void table_ptr_check(); +/* #define TRACESNDGC */ + +#define DEBUG_H +#endif diff --git a/nyqsrc/downsample.c b/nyqsrc/downsample.c new file mode 100644 index 0000000..a796ee5 --- /dev/null +++ b/nyqsrc/downsample.c @@ -0,0 +1,404 @@ +/* downsample.c -- linear interpolation to a lower sample rate */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + + + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "cext.h" +#include "downsample.h" + +void down_free(); + + +typedef struct down_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + + /* support for interpolation of s */ + sample_type s_x1_sample; + double s_pHaSe; + double s_pHaSe_iNcR; + + /* support for ramp between samples of s */ + double output_per_s; + long s_n; +} down_susp_node, *down_susp_type; + + +void down_n_fetch(susp, snd_list) + register down_susp_type susp; + snd_list_type snd_list; +{ + int cnt = 0; /* how many samples computed */ + int togo = 0; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "down_n_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = max_sample_block_len - cnt; + + /* don't run past the s input sample block: */ + susp_check_term_log_samples(s, s_ptr, s_cnt); + togo = MIN(togo, susp->s_cnt); + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); + if (togo == 0) break; + } + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + if (to_stop < togo && ((togo = to_stop) == 0)) break; + } + + n = togo; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + *out_ptr_reg++ = *s_ptr_reg++; + } while (--n); /* inner loop */ + + /* using s_ptr_reg is a bad idea on RS/6000: */ + susp->s_ptr += togo; + out_ptr += togo; + susp_took(s_cnt, togo); + cnt += togo; + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* down_n_fetch */ + + +void down_s_fetch(susp, snd_list) + register down_susp_type susp; + snd_list_type snd_list; +{ + int cnt = 0; /* how many samples computed */ + int togo = 0; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register sample_type s_scale_reg = susp->s->scale; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "down_s_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = max_sample_block_len - cnt; + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); + if (togo == 0) break; + } + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + if (to_stop < togo && ((togo = to_stop) == 0)) break; + } + + n = togo; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + *out_ptr_reg++ = (s_scale_reg * *s_ptr_reg++); + } while (--n); /* inner loop */ + + susp->s_ptr = s_ptr_reg; + out_ptr += togo; + cnt += togo; + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* down_s_fetch */ + + +void down_i_fetch(susp, snd_list) + register down_susp_type susp; + snd_list_type snd_list; +{ + int cnt = 0; /* how many samples computed */ + sample_type s_x2_sample; + int togo = 0; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register sample_type s_pHaSe_iNcR_rEg = (sample_type) susp->s_pHaSe_iNcR; + register double s_pHaSe_ReG; + register sample_type s_x1_sample_reg; + + falloc_sample_block(out, "down_i_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp_check_term_log_samples(s, s_ptr, s_cnt); + susp->s_x1_sample = susp_fetch_sample(s, s_ptr, s_cnt); + } + + susp_check_term_log_samples(s, s_ptr, s_cnt); + s_x2_sample = susp_current_sample(s, s_ptr); + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = max_sample_block_len - cnt; + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); + if (togo <= 0) { + togo = 0; + break; + } + } + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + if (to_stop < togo && ((togo = to_stop) <= 0)) { + togo = 0; + break; + } + } + + n = togo; + s_pHaSe_ReG = susp->s_pHaSe; + s_x1_sample_reg = susp->s_x1_sample; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + while (s_pHaSe_ReG >= 1.0) { + s_x1_sample_reg = s_x2_sample; + /* pick up next sample as s_x2_sample: */ + susp->s_ptr++; + susp_took(s_cnt, 1); + s_pHaSe_ReG -= 1.0; + /* derived from susp_check_term_log_samples_break, but with + a goto instead of a break */ + if (susp->s_cnt == 0) { + susp_get_samples(s, s_ptr, s_cnt); + terminate_test(s_ptr, s, susp->s_cnt); + /* see if newly discovered logical stop time: */ + logical_stop_test(s, susp->s_cnt); + if ((susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt < + susp->susp.current + cnt + togo) || + (!susp->logically_stopped && + susp->susp.log_stop_cnt != UNKNOWN && + susp->susp.log_stop_cnt < + susp->susp.current + cnt + togo)) { + goto breakout; + } + } + s_x2_sample = susp_current_sample(s, s_ptr); + } + *out_ptr_reg++ = (sample_type) + (s_x1_sample_reg * (1 - s_pHaSe_ReG) + + s_x2_sample * s_pHaSe_ReG); + s_pHaSe_ReG += s_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ +breakout: + togo -= n; + susp->s_pHaSe = s_pHaSe_ReG; + susp->s_x1_sample = s_x1_sample_reg; + out_ptr += togo; + cnt += togo; + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* down_i_fetch */ + + +void down_toss_fetch(snd_list) + snd_list_type snd_list; +{ + register down_susp_type susp = (down_susp_type) snd_list->u.susp; + long final_count = MIN(susp->susp.current + max_sample_block_len, + susp->susp.toss_cnt); + time_type final_time = susp->susp.t0 + final_count / susp->susp.sr; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while (((long) ((final_time - susp->s->t0) * susp->s->sr + 0.5)) >= + susp->s->current) + susp_get_samples(s, s_ptr, s_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + if (final_count == susp->susp.toss_cnt) { + n = ROUND((final_time - susp->s->t0) * susp->s->sr - + (susp->s->current - susp->s_cnt)); + susp->s_ptr += n; + susp_took(s_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + } + snd_list->block_len = (short) (final_count - susp->susp.current); + susp->susp.current = final_count; + snd_list->u.next = snd_list_create((snd_susp_type) susp); + snd_list->block = internal_zero_block; +} + + +void down_mark(down_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void down_free(down_susp_type susp) +{ + sound_unref(susp->s); + ffree_generic(susp, sizeof(down_susp_node), "down_free"); +} + + +void down_print_tree(down_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_down(sr, s) + rate_type sr; + sound_type s; +{ + register down_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = s->t0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + + if (s->sr < sr) { + sound_unref(s); + xlfail("snd-down: output sample rate must be lower than input"); + } + falloc_generic(susp, down_susp_node, "snd_make_down"); + + /* select a susp fn based on sample rates */ + if (s->sr == sr) { + susp->susp.fetch = ((s->scale == 1.0) ? + down_n_fetch : down_s_fetch); + } else { + susp->susp.fetch = down_i_fetch; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s->t0) sound_prepend_zeros(s, t0); + /* minimum start time over all inputs: */ + t0_min = MIN(s->t0, t0); + /* how many samples to toss before t0: */ + susp->susp.toss_cnt = ROUND((t0 - t0_min) * sr); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = down_toss_fetch; + t0 = t0_min; + } + + /* initialize susp state */ + susp->susp.free = down_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = down_mark; + susp->susp.print_tree = down_print_tree; + susp->susp.name = "down"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s); + susp->started = false; + susp->susp.current = 0; + susp->s = s; + susp->s_cnt = 0; + susp->s_pHaSe = 0.0; + susp->s_pHaSe_iNcR = s->sr / sr; + susp->s_n = 0; + susp->output_per_s = sr / s->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_down(sr, s) + rate_type sr; + sound_type s; +{ + sound_type s_copy = sound_copy(s); + return snd_make_down(sr, s_copy); +} diff --git a/nyqsrc/downsample.h b/nyqsrc/downsample.h new file mode 100644 index 0000000..1435a73 --- /dev/null +++ b/nyqsrc/downsample.h @@ -0,0 +1,3 @@ +sound_type snd_make_down(); +sound_type snd_down(); + /* LISP: (snd-down ANYNUM SOUND) */ diff --git a/nyqsrc/exitpa.h b/nyqsrc/exitpa.h new file mode 100644 index 0000000..ffdd22d --- /dev/null +++ b/nyqsrc/exitpa.h @@ -0,0 +1,3 @@ +/* exitpa.h -- declare portaudio_exit() */ + +void portaudio_exit(); diff --git a/nyqsrc/f0.cpp b/nyqsrc/f0.cpp new file mode 100644 index 0000000..7b4f08e --- /dev/null +++ b/nyqsrc/f0.cpp @@ -0,0 +1,139 @@ +// f0 -- frequency estimation + +#include <stdio.h> + + + +// Estimate a local minimum (or maximum) using parabolic +// interpolation. The parabola is defined by the points +// (x1,y1),(x2,y2), and (x3,y3). +float parabolic_interp(float x1, float x2, float x3, float y1, float y2, float y3, float *min) +{ + float a, b, c; + float pos; + + // y1=a*x1^2+b*x1+c + // y2=a*x2^2+b*x2+c + // y3=a*x3^2+b*x3+c + + // y1-y2=a*(x1^2-x2^2)+b*(x1-x2) + // y2-y3=a*(x2^2-x3^2)+b*(x2-x3) + + // (y1-y2)/(x1-x2)=a*(x1+x2)+b + // (y2-y3)/(x2-x3)=a*(x2+x3)+b + + a= ((y1-y2)/(x1-x2)-(y2-y3)/(x2-x3))/(x1-x3); + b= (y1-y2)/(x1-x2) - a*(x1+x2); + c= y1-a*x1*x1-b*x1; + + *min= c; + + // dy/dx = 2a*x + b = 0 + + pos= -b/2.0/a; + + return pos; + +} + + + +float f0_estimate(float *samples, int n, int m, float threshold, float *results, float *min) + // samples is a buffer of samples + // n is the number of samples, equals twice longest period, must be even + // m is the shortest period in samples + // results is an array of size n/2 - m + 1, the number of different lags +{ + // work from the middle of the buffer: + int middle = n / 2; + int i, j; // loop counters + // how many different lags do we compute? + float left_energy = 0; + float right_energy = 0; + // for each window, we keep the energy so we can compute the next one + // incrementally. First, we need to compute the energies for lag m-1: + for (i = 0; i < m - 1; i++) { + float left = samples[middle - 1 - i]; + left_energy += left * left; + float right = samples[middle + i]; + right_energy += right * right; + } + for (i = m; i <= middle; i++) { + // i is the lag and the length of the window + // compute the energy for left and right + float left = samples[middle - i]; + left_energy += left * left; + float right = samples[middle - 1 + i]; + + right_energy += right * right; + // compute the autocorrelation + float auto_corr = 0; + for (j = 0; j < i; j++) { + auto_corr += samples[middle - i + j] * samples[middle + j]; + } + float non_periodic = (left_energy + right_energy - 2 * auto_corr);// / i; + results[i - m] = non_periodic; + + } + + + // normalize by the cumulative sum + float cum_sum=0.0; + for (i = m; i <= middle; i++) { + cum_sum+=results[i-m]; + results[i-m]=results[i-m]/(cum_sum/(i-m+1)); + + } + + int min_i=m; // value of initial estimate + for (i = m; i <= middle; i++) { + if (results[i - m] < threshold) { + min_i=i; + break; + } else if (results[i-m]<results[min_i-m]) + min_i=i; + + } + + + + // use parabolic interpolation to improve estimate + float freq; + if (i>m && i<middle) { + freq=parabolic_interp((float)(min_i-1),(float)(min_i),(float)(min_i+1), + results[min_i-1-m],results[min_i-m],results[min_i+1-m], min); + //freq=(float)min_i; + printf("%d %f\n",min_i,freq); + } else { + freq=(float)min_i; + *min=results[min_i-m]; + } + return freq; +} + + + +float best_f0(float *samples, int n, int m, float threshold, int Tmax) + // samples is a buffer of samples + // n is the number of samples, equals twice longest period plus Tmax, must be even + // m is the shortest period in samples + // threshold is the + // results is an array of size n/2 - m + 1, the number of different lags + // Tmax is the length of the search +{ + float* results=new float[n/2-m+1]; + float min=10000000.0; + float temp; + float best_f0; + float f0; + + for (int i=0; i<Tmax; i++) { + f0=f0_estimate(&samples[i], n, m, threshold, results, &temp); + if (temp<min) { + min=temp; + best_f0=f0; + } + } + delete(results); + return best_f0; +} diff --git a/nyqsrc/f0.h b/nyqsrc/f0.h new file mode 100644 index 0000000..13c3308 --- /dev/null +++ b/nyqsrc/f0.h @@ -0,0 +1,8 @@ +#ifndef _FLOAT_H +#define _FLOAT_H + +float f0_estimate(float *samples, int n, int m, float threshold, float *results, float *min); + +float best_f0(float *samples, int n, int m, float threshold, int Tmax); + +#endif diff --git a/nyqsrc/falloc.c b/nyqsrc/falloc.c new file mode 100644 index 0000000..30b51fb --- /dev/null +++ b/nyqsrc/falloc.c @@ -0,0 +1,272 @@ +/* + * falloc.c + * data for Nyquist memory allocation. + */ + +#include <stdio.h> +#include <assert.h> +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" + +/* special free lists */ +CQUE *sample_block_free = NULL; /* really a sample_block_type */ + +/* special counts */ +int sample_block_used = 0; +int sample_block_low_water = 0; +int sample_block_total = 0; +int snd_list_used = 0; +int sound_used = 0; + +/* generic free lists */ +CQUE *generic_free[MAXLISTS]; + + +void falloc_init(void) +{ + int i; + for (i = 0; i < MAXLISTS; i++) generic_free[i] = NULL; +} + + +/* memory pool */ +char *poolp = NULL; +char *poolend = NULL; + +/* sample block memory pool */ +char *spoolp = NULL; +char *spoolend = NULL; + +int npools = 0; + +#if defined(TRACK_POOLS) && TRACK_POOLS +#define POOL_HEAD_SIZE (round_size(sizeof(CQUE))) +CQUE *pools = NULL; +#endif + +void sound_already_free_test(s) + sound_type s; +{ + sound_type sp; + for (sp = (sound_type) sound_free; sp; sp = (sound_type) ((CQUE *) sp)->qnext) { + if (s == sp) { + stdputstr("SOUND ALREADY FREE!!!"); + fflush(stdout); + sp = 0; sp->list = 0; /* trap to debugger */ + } + } +} + + +/* new_pool -- allocate a new pool from which mem is allocated */ +/**/ +void new_pool(void) +{ + poolp = (char *) malloc(MAXPOOLSIZE); + + if (poolp == NULL) { + fprintf(STDERR, "Nyquist: out of memory!\n"); + EXIT(1); + } + + poolend = poolp + MAXPOOLSIZE; + npools++; + /* stick to double word boundaries */ + poolp = (char *) round_size(((long) poolp)); +} + +/* new_spool -- allocate a new spool from which sample blocks are allocated */ +/**/ +void new_spool(void) +{ +#if defined(TRACK_POOLS) && TRACK_POOLS + spoolp = (char *) malloc(MAXSPOOLSIZE + POOL_HEAD_SIZE); +#else + spoolp = (char *) malloc(MAXSPOOLSIZE); +#endif + + if (spoolp == NULL) { + fprintf(STDERR, "Nyquist: out of memory!\n"); + EXIT(1); + } + +#if defined(TRACK_POOLS) && TRACK_POOLS + Qenter(pools, spoolp); + spoolp += POOL_HEAD_SIZE; +#endif + + spoolend = spoolp + MAXSPOOLSIZE; + npools++; + /* stick to double word boundaries */ + spoolp = (char *) round_size(((long) spoolp)); +} + + +/* find_sample_block -- get sample block when freelist is empty */ +/* Try these strategies in order: + 1) try free list + 2) use pool to get sample_blocks_low_water + BLOCKS_PER_GC blocks or until + pool runs out + 3) GC and try free list again, set sample_blocks_low_water to + sample_blocks_used + 4) try pool again + 5) allocate new pool and use it + */ +sample_block_type find_sample_block(void) +{ + sample_block_type sp; + if (sample_block_total < sample_block_low_water + BLOCKS_PER_GC && + check_spool(round_size(sizeof(sample_block_node)))) { + if (DEBUG_MEM) spoolp += DEBUG_MEM_INFO_SIZE; + sp = (sample_block_type) spoolp; + spoolp += round_size(sizeof(sample_block_node)); + sample_block_total++; +/* printf("fp%d ", sample_block_total - sample_block_low_water); */ + } else { +/* printf("falloc calling gc\n"); */ + gc(); + sample_block_low_water = sample_block_used; + if (!Qempty(sample_block_free)) { + Qget(sample_block_free, sample_block_type, sp); +/* printf("gc, then from freelist\n"); */ + } else if (check_spool(round_size(sizeof(sample_block_node)))) { + if (DEBUG_MEM) spoolp += DEBUG_MEM_INFO_SIZE; + sp = (sample_block_type) spoolp; + spoolp += round_size(sizeof(sample_block_node)); + sample_block_total++; +/* printf("gc, then from spool\n"); */ + } else { + new_spool(); + if (DEBUG_MEM) spoolp += DEBUG_MEM_INFO_SIZE; + sp = (sample_block_type) spoolp; + spoolp += round_size(sizeof(sample_block_node)); + sample_block_total++; +/* printf("gc, then new spool\n"); */ + } + } + return sp; +} + + + +/* get_from_pool -- return size bytes from pool memory */ +/**/ +char *get_from_pool(size_t siz) +{ + if (!check_pool(siz)) { + new_pool(); + } + poolp += siz; + if (DEBUG_MEM) poolp += DEBUG_MEM_INFO_SIZE; /* allow for debug info */ + return poolp - siz; +} + + +#if defined(TRACK_POOLS) && TRACK_POOLS + +/* falloc_gc -- return empty pools to the system */ +/* + * Algorithm: for each pool, move all free sample blocks + * (on the sample_block_free list) to tlist. If tlist + * has ALL of the blocks in the pool (determined by + * byte counts), the pool is returned to the heap. + */ +void falloc_gc() +{ + CQUE *lp = NULL; + CQUE *cp; + CQUE *np; + CQUE *tlist = NULL; + + /* Scan all allocated pools */ + for (cp = pools; cp; lp = cp, cp = np) { + char *str = ((char *)cp) + POOL_HEAD_SIZE; + char *end = str + MAXSPOOLSIZE; + long tsiz = end - str; + long csiz = 0; + CQUE *tsave = NULL; + CQUE *ln = NULL; + CQUE *cn; + CQUE *nn; + + /* Save pointer to next pool */ + np = cp->qnext; + + /* Remember head of temp free list */ + tsave = tlist; + + /* Scan all nodes on the free list */ + for (cn = sample_block_free; cn; ln = cn, cn = nn) { + + /* Get next node */ + nn = cn->qnext; + + /* Count it if the node belongs to this pool */ + if (cn >= (CQUE *) str && cn <= (CQUE *) end) { + csiz += round_size(sizeof(sample_block_node)); + + Qenter(tlist, cn); + + /* Unlink the node */ + if (cn == sample_block_free) { + sample_block_free = nn; + cn = NULL; + } + else { + ln->qnext = nn; + cn = ln; + } + } + } + + /* The pool had inuse nodes */ + if (csiz != tsiz) { + continue; + } + + /* Remove the nodes from the temp free list */ + tlist = tsave; + + /* Maintain stats */ + sample_block_total -= (tsiz / round_size(sizeof(sample_block_node))); + npools--; + + /* If this is the active pool, then reset current pointers */ + if (spoolp >= str && spoolp <= end) { + spoolp = NULL; + spoolend = NULL; + } + + /* Release the pool to the system */ + free(cp); + + /* Unlink this pool from the list */ + if (cp == pools) { + pools = np; + cp = NULL; + } + else { + /* lp cannot be null here: On 1st iteration, lp == NULL, but + * cp == pools, so code above is executed. Before the for-loop + * iterates, pools == np (assigned above), and cp == NULL. The + * for-loop update (lp=cp,cp=np) produces lp == NULL, cp == pools. + * Since cp == pools, this else branch will not be taken. + * The other path to this code is via the "continue" above. In that + * case, the update (lp=cp,cp=np) makes lp a valid pointer or else + * the loop exits. + * The assert(lp) is here to possibly make static analyzers happy. + */ + assert(lp); + lp->qnext = np; + cp = lp; + } + } + + /* Resave list of free nodes */ + sample_block_free = tlist; +} + +#endif + + diff --git a/nyqsrc/falloc.h b/nyqsrc/falloc.h new file mode 100644 index 0000000..1219bfd --- /dev/null +++ b/nyqsrc/falloc.h @@ -0,0 +1,253 @@ +/* + * falloc.h + * nyquist memory allocation data structures and macros + * + * there is an falloc and ffree for each major type of data structure + * there is an falloc and ffree for generic (not so common) structures + * there is an frelease for some structures. this reduces the + * reference count for the particular structure by 1; it + * does not continue recursively. + */ + +/* Debugging support: + * When DEBUG_MEM is set, each piece of allocated storage will contain + * a pointer to a string naming the caller or other allocation info, + * and a sequence number. (8 extra bytes are allocated for this info). + * + * When storage is freed, the ID is set to NULL, and the routine + * dbg_mem_check(ptr) will abort if ID is NULL. Call this routine to + * avoid following a pointer to data that was previously freed. + * + * The goal of this support is to allow you to "go back" to the point + * where memory is corrupted; specifically where a memory block is freed + * too early. + * + * When a memory-related bug is crashing the system: + * (1) Recompile with DEBUG_MEM on. + * (2) Develop some Nyquist code that will predictably crash the system. + * (3) When Nyquist crashes, use a debugger to find where the bad + * pointer came from. See if the source of the pointer was freed. + * (4) If the source of the pointer was freed, then notice the sequence + * number. + * (5) Rerun with dbg_mem_seq_num set to the number noted in (4). + * (6) Nyquist will print when the storage in question was allocated and + * freed. Use the debugger to find out why the storage is + * freed too early and who did it. + * (7) If the source of the pointer in (3) was not freed, you're on your + * own. + * + * The DEBUG_MEM related routines are: + * dbg_mem_allocated: called when memory is allocated + * dbg_mem_freed: called when memory is freed + * dbg_mem_released: called when memory is released + * dbg_mem_check: called to check memory + * + * see also xldmem.c: + * by setting xldmem_trace to a pointer, you can trace when the + * pointer is referenced by anything in the heap + */ + + +/* to get size_t on pmax: */ +#ifdef pmax +#include "sys/types.h" +#endif + +#include "cque.h" +#include "debug.h" + +#define DEBUG_MEM 0 +#define DEBUG_MEM_INFO_SIZE (sizeof(long) + sizeof(char *)) + +/* special free lists */ +extern CQUE *sample_block_free; /* really a sample_block_type */ + +/* special counts */ +extern int sample_block_total; +extern int sample_block_used; +extern int snd_list_used; +extern int sound_used; +extern long table_memory; + +/* generic free lists */ +#define MAXLISTS 128 +extern CQUE *generic_free[MAXLISTS]; + +/* general memory pool */ +#define MAXPOOLSIZE 1000000 +extern char *poolp; +extern char *poolend; + +/* sample block memory pool */ +#define MAXSPOOLSIZE (256 * round_size(sizeof(sample_block_node))) +extern char *spoolp; +extern char *spoolend; + +extern int npools; +extern int sample_blocks_since_gc; + +#if !defined(TRACK_POOLS) +#define TRACK_POOLS 1 +#endif + +#if defined(TRACK_POOLS) && TRACK_POOLS +// extern CQUE *pools; +void falloc_gc(); +#endif + +void falloc_init(void); +void new_pool(void); +void new_spool(void); +sample_block_type find_sample_block(void); + +char *get_from_pool(size_t siz); + +#define round_size(n) (((n) + 7) & ~7) + +/* check_pool -- returns true if enough bytes are available */ +#if DEBUG_MEM +#define check_pool(size) (poolp + (size) + DEBUG_MEM_INFO_SIZE <= poolend) +#define check_spool(size) (spoolp + (size) + DEBUG_MEM_INFO_SIZE <= spoolend) +#define DBG_MEM_ALLOCATED(p, who) dbg_mem_allocated(p, who) +#define DBG_MEM_FREED(p, who) dbg_mem_freed(p, who) +#define DBG_MEM_RELEASED(p, who) dbg_mem_released(p, who) +#else +#define check_pool(size) (poolp + (size) <= poolend) +#define check_spool(size) (spoolp + (size) <= spoolend) +#define DBG_MEM_ALLOCATED(p, who) +#define DBG_MEM_FREED(p, who) +#define DBG_MEM_RELEASED(p, who) +#endif + +#define BLOCKS_PER_GC 100 + +#define falloc_sample_block(sp, who) { \ + if (!Qempty(sample_block_free)) \ + Qget(sample_block_free, sample_block_type, sp) \ + else sp = find_sample_block(); \ + /* sample_block_test(sp, "falloc_sample_block"); */ \ + /* printf("[%x] ", sp); */ \ + DBG_MEM_ALLOCATED(sp, who); \ + sp->refcnt = 1; \ + sample_block_used++; \ +} + + +#define ffree_sample_block(sp, who) { \ + /* printf("freeing sample_block@%x\n", sp); */ \ + DBG_MEM_FREED(sp, who); \ + Qenter(sample_block_free, sp); \ + sample_block_used--; \ +} + +#define frelease_sample_block(sp, who) { \ + sp->refcnt--; \ + DBG_MEM_RELEASED(sp, who); \ + if (sp->refcnt <= 0) { \ + ffree_sample_block(sp); \ + } \ +} + + +/* NOTE: This must not cause garbage collection. + * LVAL parameters to snd_make_? functions are not + * protected and falloc_sound is invoked there. + */ +#define snd_list_free (generic_free[round_size(sizeof(snd_list_node)) >> 3]) + +#define falloc_snd_list(sp, who) { \ + if (!Qempty(snd_list_free)) \ + Qget(snd_list_free, snd_list_type, sp) \ + else \ + sp = (snd_list_type)get_from_pool(round_size(sizeof(snd_list_node)));\ + snd_list_used++; \ + DBG_MEM_ALLOCATED(sp, who); \ +} + + +#define ffree_snd_list(sp, who) { \ + DBG_MEM_FREED(sp, who); \ + Qenter(snd_list_free, sp); \ + snd_list_used--; \ +} + + +#define frelease_snd_list(sp, who) { \ + sp->refcnt--; \ + DBG_MEM_RELEASED(sp, who); \ + if (sp->refcnt <= 0) { \ + ffree_snd_list(sp, who); \ + } \ +} + + +#define sound_free (generic_free[round_size(sizeof(sound_node)) >> 3]) + +#define NORMALSOUNDALLOC +#ifdef NORMALSOUNDALLOC +#define falloc_sound(sp, who) { \ + if (!Qempty(sound_free)) { \ + Qget(sound_free, sound_type, sp); \ + } else { \ + sp = (sound_type) get_from_pool(round_size(sizeof(sound_node))); \ + } \ + sound_used++; \ + DBG_MEM_ALLOCATED(sp, who); \ +} +#else +#define falloc_sound(sp) \ + sp =(sound_type) \ + get_from_pool(round_size(sizeof(sound_node))) +#endif + +/* note: usually you call sound_unref, not this macro */ +#define ffree_sound(sp, who) { \ +/* sound_already_free_test(); */ \ + DBG_MEM_FREED(sp, who); \ + Qenter(sound_free, sp); \ + sound_used--; \ +} + + +/* falloc_generic -- sp gets new node of type sptype */ +/**/ +#define falloc_generic(sp, sptype, who) { \ + int size = round_size(sizeof(sptype)); \ + falloc_generic_bytes(sp, sptype, size, who) } + +/* falloc_generic_n -- sp gets new array of n sptype's */ +/**/ +#define falloc_generic_n(sp, sptype, n, who) { \ + int min_size = sizeof(sptype) * (n); \ + int size = round_size(min_size); \ + falloc_generic_bytes(sp, sptype, size, who) } + +#define falloc_generic_bytes(sp, sptype, size, who) \ + if ((size >> 3) >= MAXLISTS) { \ + stdputstr("falloc_generic problem\n"); \ + sp = (sptype *) malloc(size); \ + } else if (!Qempty(generic_free[size >> 3])) { \ + Qget(generic_free[size >> 3], sptype *, sp); \ + } else { \ + sp = (sptype *) get_from_pool(size); \ + } \ + DBG_MEM_ALLOCATED(sp, who); \ +/* printf("GENERIC ALLOC %x\n", sp); */ + + +/* ffree_generic puts an item back on proper freelist */ +/* NOTE: sIzE is capitalized funny so that it will not + * match an actual parameter, e.g. if the caller writes + * ffree_generic(ptr, size), we don't want the expanded + * code to include: "int size = round_size(size) >> 3"! + */ +#define ffree_generic(sp, nn, who) { \ + int sIzE = round_size(nn) >> 3; \ + DBG_MEM_FREED(sp, who); \ + /* printf("GENERIC FREE %x SIZE %d\n", sp, nnn); */ \ + if ((sIzE) >= MAXLISTS) { \ + free(sp); \ + } else { \ + Qenter(generic_free[sIzE], sp); \ + } \ +} diff --git a/nyqsrc/ffilterkit.c b/nyqsrc/ffilterkit.c new file mode 100644 index 0000000..d78d5c5 --- /dev/null +++ b/nyqsrc/ffilterkit.c @@ -0,0 +1,123 @@ +/* + * ffilterkit.c (library "filterkit.a"): + * Kaiser-windowed low-pass filter support. + */ + +/* ffilterkit.c + * + * FilterUp() - Applies a filter to a given sample when up-converting. + * FilterUD() - Applies a filter to a given sample when up- or down- + * converting. + */ + + /* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +#include <stdio.h> +#include <math.h> +#include <string.h> +#include "stdefs.h" +#include "fresample.h" +#include "ffilterkit.h" + + +fast_float FilterUp(float Imp[], float ImpD[], + int Nwing, boolean Interp, + float *Xp, double Ph, int Inc) +{ + float *Hp, *Hdp = NULL, *End; + fast_float a = 0; + fast_float v, t; + double exact_index = Ph * Npc; + long index = (long) exact_index; /* convert fraction to filter index */ + +/* nyquist_printf("FilterUp, Inc %d, phase %g\n", Inc, Ph); */ + v=0; + Hp = &Imp[index]; + End = &Imp[Nwing]; + if (Interp) { + Hdp = &ImpD[index]; + a = exact_index - index; +/* nyquist_printf("fraction %g\n", a); */ + } + if (Inc == 1) /* If doing right wing... */ + { /* ...drop extra coeff, so when Ph is */ + End--; /* 0.5, we don't do too many mult's */ + if (Ph == 0) /* If the phase is zero... */ + { /* ...then we've already skipped the */ + Hp += Npc; /* first sample, so we must also */ + Hdp += Npc; /* skip ahead in Imp[] and ImpD[] */ + } + } + if (Interp) { + while (Hp < End) { + t = *Hp; /* Get filter coeff */ + /* t scaled by 2^(16 + NLpScl)/LpScl */ + t += *Hdp *a; /* t is now interp'd filter coeff */ + Hdp += Npc; /* Filter coeff differences step */ + t *= *Xp; /* Mult coeff by input sample */ + /* t scaled by 2^(16 + NLpScl)/LpScl */ + v += t; /* The filter output */ + Hp += Npc; /* Filter coeff step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + } + } else { + while (Hp < End) { + t = *Hp; /* Get filter coeff */ + t *= *Xp; /* Mult coeff by input sample */ + v += t; /* The filter output */ + Hp += Npc; /* Filter coeff step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + } + } + return(v); +} + +fast_float FilterUD( float Imp[], float ImpD[], + int Nwing, boolean Interp, + float *Xp, double Ph, int Inc, double dhb) +{ + double a; + float *Hp, *Hdp, *End; + fast_float v, t; + double Ho; + + v=0; + Ho = Ph*dhb; + End = &Imp[Nwing]; + if (Inc == 1) /* If doing right wing... */ + { /* ...drop extra coeff, so when Ph is */ + End--; /* 0.5, we don't do too many mult's */ + if (Ph == 0) /* If the phase is zero... */ + Ho += dhb; /* ...then we've already skipped the */ + } /* first sample, so we must also */ + /* skip ahead in Imp[] and ImpD[] */ + if (Interp) { + long HoIndex = (long) Ho; + while ((Hp = &Imp[HoIndex]) < End) { + t = *Hp; /* Get IR sample */ + Hdp = &ImpD[HoIndex]; /* get interp (lower Na) bits from diff table*/ + a = Ho - HoIndex; /* a is logically between 0 and 1 */ + t += *Hdp * a; /* t is now interp'd filter coeff */ + t *= *Xp; /* Mult coeff by input sample */ + v += t; /* The filter output */ + Ho += dhb; /* IR step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + HoIndex = (long) Ho; + } + } else { + long HoIndex = (long) Ho; + while ((Hp = &Imp[HoIndex]) < End) { + t = *Hp; /* Get IR sample */ + t *= *Xp; /* Mult coeff by input sample */ + v += t; /* The filter output */ + Ho += dhb; /* IR step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + HoIndex = (long) Ho; + } + } + return(v); +} + diff --git a/nyqsrc/ffilterkit.h b/nyqsrc/ffilterkit.h new file mode 100644 index 0000000..d277e7d --- /dev/null +++ b/nyqsrc/ffilterkit.h @@ -0,0 +1,15 @@ +/*:filterkit.h */ + +/* + * FilterUp() - Applies a filter to a given sample when up-converting. + * FilterUD() - Applies a filter to a given sample when up- or down- + * converting. + */ + +fast_float FilterUp(mem_float Imp[], mem_float ImpD[], int Nwing, + boolean Interp, mem_float *Xp, double Ph, int Inc); + +fast_float FilterUD(mem_float Imp[], mem_float ImpD[], int Nwing, + boolean Interp, mem_float *Xp, double Ph, int Inc, + double dhb); + diff --git a/nyqsrc/fft-rbd.c b/nyqsrc/fft-rbd.c new file mode 100644 index 0000000..6d01e6a --- /dev/null +++ b/nyqsrc/fft-rbd.c @@ -0,0 +1,156 @@ +/* samples.c -- fugue sound data type */ + +#include <stdio.h> +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "fft.h" + + +/* NOTE: this code does not properly handle start times that do not + * correspond to the time of the first actual sample + */ + + +/* snd_fetch_array -- fetch a lisp array of samples */ +/* + * storage layout: the extra field points to extra state that we'll use + * extra[0] -> length of extra storage + * extra[1] -> CNT (number of samples in current block) + * extra[2] -> INDEX (current sample index in current block) + * extra[3] -> FILLCNT (how many samples in buffer) + * extra[4] -> TERMCNT (how many samples until termination) + * extra[4 .. 4+len-1] -> samples (stored as floats) + * + * Termination details: + * Return NIL when the sound terminates. + * Termination is defined as the point where all original + * signal samples have been shifted out of the samples buffer + * so that all that's left are zeros from beyond the termination + * point. + * Implementation: when termination is discovered, set TERMCNT + * to the number of samples to be shifted out. TERMCNT is initially + * -1 as a flag that we haven't seen the termination yet. + * Each time samples are shifted, decrement TERMCNT by the shift amount. + * When TERMCNT goes to zero, return NULL. + */ + +#define CNT extra[1] +#define INDEX extra[2] +#define FILLCNT extra[3] +#define TERMCNT extra[4] +#define OFFSET 5 +#define SAMPLES list->block->samples + +LVAL snd_fft(sound_type s, long len, long step /* more parameters may belong here */) +{ + long i, maxlen, skip, fillptr; + float *samples; + LVAL result; + + if (len < 1) xlfail("len < 1"); + + if (!s->extra) { /* this is the first call, so fix up s */ + /* note: any storage required by fft must be allocated here in a contiguous + * block of memory who's size is given by the first long in the block. + * Here, there are 4 more longs after the size, and then room for len floats + * (assumes that floats and longs take equal space). + * + * The reason for this storage restriction is that when a sound is freed, the + * block of memory pointed to by extra is also freed. There is no function + * call that might free a more complex structure (this could be added in sound.c + * however if it's really necessary). + */ + falloc_generic_n(s->extra, long, len + OFFSET, "snd_fft"); + s->extra[0] = sizeof(long) * (len + OFFSET); + s->CNT = s->INDEX = s->FILLCNT = 0; + s->TERMCNT = -1; + maxlen = len; + } else { + maxlen = (s->extra[0] / sizeof(long)) - OFFSET; + if (maxlen < 1) xlfail("sound in use by another iterator"); + if (maxlen < len) xlfail("len grew"); + } + samples = (float *) &(s->extra[OFFSET]); + + /* step 1: refill buffer with samples */ + fillptr = s->FILLCNT; + while (fillptr < maxlen) { + if (s->INDEX == s->CNT) { + sound_get_next(s, &(s->CNT)); + if (s->SAMPLES == zero_block->samples) { + if (s->TERMCNT < 0) s->TERMCNT = fillptr; + } + s->INDEX = 0; + } + samples[fillptr++] = s->SAMPLES[s->INDEX++] * s->scale; + } + s->FILLCNT = fillptr; + + /* it is important to test here AFTER filling the buffer, because + * if fillptr WAS 0 when we hit the zero_block, then filling the + * buffer will set TERMCNT to 0. + */ + if (s->TERMCNT == 0) return NULL; + + /* logical stop time is ignored by this code -- to fix this, + * you would need a way to return the logical stop time to + * the caller. + */ + + /* HERE IS WHERE THE FFT SHOULD TAKE PLACE ON samples. DO NOT + * DESTROY SAMPLES IF YOU WANT TO ALLOW OVERLAPPED FFT'S. THE + * CURRENT CODE RETURNS SAMPLES, BUT A REAL FFT WOULD RETURN + * THE RESULT OF THE FFT IN STEP 2, WHICH FOLLOWS: + */ + + /* step 2: construct an array and return it */ + xlsave1(result); + result = newvector(len); + + for (i = 0; i < len; i++) { + setelement(result, i, cvflonum(samples[i])); + } + + /* step 3: shift samples by step */ + if (step < 0) xlfail("step < 0"); + s->FILLCNT -= step; + if (s->FILLCNT < 0) s->FILLCNT = 0; + for (i = 0; i < s->FILLCNT; i++) { + samples[i] = samples[i + step]; + } + + + if (s->TERMCNT >= 0) { + s->TERMCNT -= step; + if (s->TERMCNT < 0) s->TERMCNT = 0; + } + + + /* step 4: advance in sound to next sample we need + * (only does work if step > size of buffer) + */ + skip = step - maxlen; + while (skip > 0) { + long remaining = s->CNT - s->INDEX; + if (remaining >= skip) { + s->INDEX += skip; + skip = 0; + } else { + skip -= remaining; + sound_get_next(s, &(s->CNT)); + s->INDEX = 0; + } + } + + /* restore the stack */ + xlpop(); + return result; +} /* snd_fetch_array */ + + + + diff --git a/nyqsrc/fft.c b/nyqsrc/fft.c new file mode 100644 index 0000000..95095ac --- /dev/null +++ b/nyqsrc/fft.c @@ -0,0 +1,223 @@ +/* fft.c -- implement snd_fft */ + +#define _USE_MATH_DEFINES 1 /* for Visual C++ to get M_LN2 */ +#include <math.h> +#include <stdio.h> +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "fft.h" +#include "fftext.h" + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm change for portability: min->MIN + */ + + +/* NOTE: this code does not properly handle start times that do not + * correspond to the time of the first actual sample + */ + + +/* The snd_fft function is based on snd_fetch_array */ +/* + * storage layout: the extra field points to extra state that we'll use + * extra[0] -> length of extra storage + * extra[1] -> CNT (number of samples in current block) + * extra[2] -> INDEX (current sample index in current block) + * extra[3] -> FILLCNT (how many samples in buffer) + * extra[4] -> TERMCNT (how many samples until termination) + * extra[5 .. 5+len-1] -> samples (stored as floats) + * extra[5+len .. 5+2*len-1] -> array of samples to fft + * extra[5+2*len ... 5+3*len-1] -> window coefficients + * + * Termination details: + * Return NIL when the sound terminates. + * Termination is defined as the point where all original + * signal samples have been shifted out of the samples buffer + * so that all that's left are zeros from beyond the termination + * point. + * Implementation: when termination is discovered, set TERMCNT + * to the number of samples to be shifted out. TERMCNT is initially + * -1 as a flag that we haven't seen the termination yet. + * Each time samples are shifted, decrement TERMCNT by the shift amount. + * When TERMCNT goes to zero, return NULL. + */ + +#define CNT extra[1] +#define INDEX extra[2] +#define FILLCNT extra[3] +#define TERMCNT extra[4] +#define OFFSET 5 +#define SAMPLES list->block->samples + +/* DEBUGGING PRINT FUNCTION: + void printfloats(char *caption, float *data, int len) + { + int i; + printf("%s: ", caption); + for (i = 0; i < len; i++) { + printf("%d:%g ", i, data[i]); + } + printf("\n"); + } +*/ + +void n_samples_from_sound(sound_type s, long n, float *table) +{ + long blocklen; + sample_type scale_factor = s->scale; + s = sound_copy(s); + while (n > 0) { + sample_block_type sampblock = sound_get_next(s, &blocklen); + long togo = MIN(blocklen, n); + long i; + sample_block_values_type sbufp = sampblock->samples; + for (i = 0; i < togo; i++) { + *table++ = (float) (*sbufp++ * scale_factor); + } + n -= togo; + } + sound_unref(s); +} + + +LVAL snd_fft(sound_type s, long len, long step, LVAL winval) +{ + long i, m, maxlen, skip, fillptr; + float *samples; + float *temp_fft; + float *window; + LVAL result; + + if (len < 1) xlfail("len < 1"); + + if (!s->extra) { /* this is the first call, so fix up s */ + sound_type w = NULL; + if (winval) { + if (soundp(winval)) { + w = getsound(winval); + } else { + xlerror("expected a sound", winval); + } + } + /* note: any storage required by fft must be allocated here in a + * contiguous block of memory who's size is given by the first long + * in the block. Here, there are 4 more longs after the size, and + * then room for 3*len floats (assumes that floats and longs take + * equal space). + * + * The reason for 3*len floats is to provide space for: + * the samples to be transformed (len) + * the complex FFT result (len) + * the window coefficients (len) + * + * The reason for this storage restriction is that when a sound is + * freed, the block of memory pointed to by extra is also freed. + * There is no function call that might free a more complex + * structure (this could be added in sound.c, however, if it's + * really necessary). + */ + s->extra = (long *) malloc(sizeof(long) * (3 * len + OFFSET)); + s->extra[0] = sizeof(long) * (3 * len + OFFSET); + s->CNT = s->INDEX = s->FILLCNT = 0; + s->TERMCNT = -1; + maxlen = len; + window = (float *) &(s->extra[OFFSET + 2 * len]); + /* fill the window from w */ + if (!w) { + for (i = 0; i < len; i++) *window++ = 1.0F; + } else { + n_samples_from_sound(w, len, window); + } + } else { + maxlen = ((s->extra[0] / sizeof(long)) - OFFSET) / 3; + if (maxlen != len) xlfail("len changed from initial value"); + } + samples = (float *) &(s->extra[OFFSET]); + temp_fft = samples + len; + window = temp_fft + len; + /* step 1: refill buffer with samples */ + fillptr = s->FILLCNT; + while (fillptr < maxlen) { + if (s->INDEX == s->CNT) { + sound_get_next(s, &(s->CNT)); + if (s->SAMPLES == zero_block->samples) { + if (s->TERMCNT < 0) s->TERMCNT = fillptr; + } + s->INDEX = 0; + } + samples[fillptr++] = s->SAMPLES[s->INDEX++] * s->scale; + } + s->FILLCNT = fillptr; + + /* it is important to test here AFTER filling the buffer, because + * if fillptr WAS 0 when we hit the zero_block, then filling the + * buffer will set TERMCNT to 0. + */ + if (s->TERMCNT == 0) return NULL; + + /* logical stop time is ignored by this code -- to fix this, + * you would need a way to return the logical stop time to + * the caller. + */ + + /* step 2: construct an array and return it */ + xlsave1(result); + result = newvector(len); + + /* first len floats will be real part, second len floats imaginary + * copy buffer to temp_fft with windowing + */ + for (i = 0; i < len; i++) { + temp_fft[i] = samples[i] * *window++; + } + /* perform the fft: */ + m = round(log(len) / M_LN2); /* compute log-base-2(len) */ + if (!fftInit(m)) rffts(temp_fft, m, 1); + else xlfail("FFT initialization error"); + + /* move results to Lisp array */ + setelement(result, 0, cvflonum(temp_fft[0])); + setelement(result, len - 1, cvflonum(temp_fft[1])); + for (i = 2; i < len; i++) { + setelement(result, i - 1, cvflonum(temp_fft[i])); + } + + /* step 3: shift samples by step */ + if (step < 0) xlfail("step < 0"); + s->FILLCNT -= step; + if (s->FILLCNT < 0) s->FILLCNT = 0; + for (i = 0; i < s->FILLCNT; i++) { + samples[i] = samples[i + step]; + } + + if (s->TERMCNT >= 0) { + s->TERMCNT -= step; + if (s->TERMCNT < 0) s->TERMCNT = 0; + } + + /* step 4: advance in sound to next sample we need + * (only does work if step > size of buffer) + */ + skip = step - maxlen; + while (skip > 0) { + long remaining = s->CNT - s->INDEX; + if (remaining >= skip) { + s->INDEX += skip; + skip = 0; + } else { + skip -= remaining; + sound_get_next(s, &(s->CNT)); + s->INDEX = 0; + } + } + + /* restore the stack */ + xlpop(); + return result; +} /* snd_fetch_array */ diff --git a/nyqsrc/fft.h b/nyqsrc/fft.h new file mode 100644 index 0000000..74b2b24 --- /dev/null +++ b/nyqsrc/fft.h @@ -0,0 +1,4 @@ +/* fft.h -- fft returned through a lisp array */ + +LVAL snd_fft(sound_type s, long len, long step, LVAL w); + /* LISP: (SND-FFT SOUND FIXNUM FIXNUM ANY) */ diff --git a/nyqsrc/fftr4.c b/nyqsrc/fftr4.c new file mode 100644 index 0000000..d5dfcc9 --- /dev/null +++ b/nyqsrc/fftr4.c @@ -0,0 +1,264 @@ +#include <stdio.h> +#include <stdlib.h> +#include <math.h> +#ifdef WIN32 +#include <sys\time.h> +#else +#include <sys/time.h> +#endif + +#define PI 3.14159265359 +#define MAXPOW 24 + +struct complex +{ + double r; + double i; +}; + +int pow_2[MAXPOW]; +int pow_4[MAXPOW]; + +void twiddle(struct complex *W, int N, double stuff) +{ + W->r=cos(stuff*2.0*PI/(double)N); + W->i=-sin(stuff*2.0*PI/(double)N); +} + +void bit_reverse_reorder(struct complex *W, int N) +{ + int bits, i, j, k; + double tempr, tempi; + + for (i=0; i<MAXPOW; i++) + if (pow_2[i]==N) bits=i; + + for (i=0; i<N; i++) + { + j=0; + for (k=0; k<bits; k++) + if (i&pow_2[k]) j+=pow_2[bits-k-1]; + + if (j>i) /** Only make "up" swaps */ + { + tempr=W[i].r; + tempi=W[i].i; + W[i].r=W[j].r; + W[i].i=W[j].i; + W[j].r=tempr; + W[j].i=tempi; + } + } +} +void bit_r4_reorder(struct complex *W, int N) +{ + int bits, i, j, k; + double tempr, tempi; + + for (i=0; i<MAXPOW; i++) + if (pow_2[i]==N) bits=i; + + for (i=0; i<N; i++) + { + j=0; + for (k=0; k<bits; k+=2) + { + if (i&pow_2[k]) j+=pow_2[bits-k-2]; + if (i&pow_2[k+1]) j+=pow_2[bits-k-1]; + } + + if (j>i) /** Only make "up" swaps */ + { + tempr=W[i].r; + tempi=W[i].i; + W[i].r=W[j].r; + W[i].i=W[j].i; + W[j].r=tempr; + W[j].i=tempi; + } + } +} + +/** RADIX-4 FFT ALGORITHM */ +void radix4(struct complex *x, int N) +{ + int n2, k1, N1, N2; + struct complex W, bfly[4]; + + N1=4; + N2=N/4; + + /** Do 4 Point DFT */ + for (n2=0; n2<N2; n2++) + { + /** Don't hurt the butterfly */ + bfly[0].r = (x[n2].r + x[N2 + n2].r + x[2*N2+n2].r + x[3*N2+n2].r); + bfly[0].i = (x[n2].i + x[N2 + n2].i + x[2*N2+n2].i + x[3*N2+n2].i); + + bfly[1].r = (x[n2].r + x[N2 + n2].i - x[2*N2+n2].r - x[3*N2+n2].i); + bfly[1].i = (x[n2].i - x[N2 + n2].r - x[2*N2+n2].i + x[3*N2+n2].r); + + bfly[2].r = (x[n2].r - x[N2 + n2].r + x[2*N2+n2].r - x[3*N2+n2].r); + bfly[2].i = (x[n2].i - x[N2 + n2].i + x[2*N2+n2].i - x[3*N2+n2].i); + + bfly[3].r = (x[n2].r - x[N2 + n2].i - x[2*N2+n2].r + x[3*N2+n2].i); + bfly[3].i = (x[n2].i + x[N2 + n2].r - x[2*N2+n2].i - x[3*N2+n2].r); + + + /** In-place results */ + for (k1=0; k1<N1; k1++) + { + twiddle(&W, N, (double)k1*(double)n2); + x[n2 + N2*k1].r = bfly[k1].r*W.r - bfly[k1].i*W.i; + x[n2 + N2*k1].i = bfly[k1].i*W.r + bfly[k1].r*W.i; + } + } + + /** Don't recurse if we're down to one butterfly */ + if (N2!=1) + for (k1=0; k1<N1; k1++) + { + radix4(&x[N2*k1], N2); + } +} + +/** RADIX-2 FFT ALGORITHM */ +void radix2(struct complex *data, int N) +{ + int n2, k1, N1, N2; + struct complex W, bfly[2]; + + N1=2; + N2=N/2; + + /** Do 2 Point DFT */ + for (n2=0; n2<N2; n2++) + { + /** Don't hurt the butterfly */ + twiddle(&W, N, (double)n2); + bfly[0].r = (data[n2].r + data[N2 + n2].r); + bfly[0].i = (data[n2].i + data[N2 + n2].i); + bfly[1].r = (data[n2].r - data[N2 + n2].r) * W.r - + ((data[n2].i - data[N2 + n2].i) * W.i); + bfly[1].i = (data[n2].i - data[N2 + n2].i) * W.r + + ((data[n2].r - data[N2 + n2].r) * W.i); + + /** In-place results */ + for (k1=0; k1<N1; k1++) + { + data[n2 + N2*k1].r = bfly[k1].r; + data[n2 + N2*k1].i = bfly[k1].i; + } + } + + /** Don't recurse if we're down to one butterfly */ + if (N2!=1) + for (k1=0; k1<N1; k1++) + radix2(&data[N2*k1], N2); +} + +void main(int argc, char *argv[]) +{ + FILE *infile; + int N, radix, numsamp; + int i; + struct complex *data; + double freq, phase, fs, A; + int dotime; + struct timeval start, end; + long totaltime; + +#ifdef GEN + if (argc!=9) + { + printf("usage:\n"); + printf(" fft [A] [f] [phase] [fs] [num samp] [sequence length] [radix] [time]\n"); + printf(" output: DFT\n"); + exit(1); + } + + + sscanf(argv[1], "%lf", &A); + sscanf(argv[2], "%lf", &freq); + sscanf(argv[3], "%lf", &phase); + sscanf(argv[4], "%lf", &fs); + sscanf(argv[5], "%d", &numsamp); + sscanf(argv[6], "%d", &N); + sscanf(argv[7], "%d", &radix); + sscanf(argv[8], "%d", &dotime); +#endif +#ifndef GEN + if (argc<4) + { + printf("usage:\n"); + printf(" fft [input file] [sequence length] [radix]\n"); + printf(" output: DFT\n"); + exit(1); + } + else if ((infile=fopen(argv[1], "r"))==NULL) + { + printf("Error reading input sequence file: %s\n", argv[1]); + exit(1); + } + + sscanf(argv[2], "%d", &N); + sscanf(argv[3], "%d", &radix); + dotime=0; +#endif + + + /** Set up power of two arrays */ + pow_2[0]=1; + for (i=1; i<MAXPOW; i++) + pow_2[i]=pow_2[i-1]*2; + pow_4[0]=1; + for (i=1; i<MAXPOW; i++) + pow_4[i]=pow_4[i-1]*4; + + if ((data=malloc(sizeof(struct complex)*(size_t)N))==NULL) + { + fprintf(stderr, "Out of memory!\n"); + exit(1); + } + + /** Generate cosine **/ +#ifdef GEN + for (i=0; i<N; i++) + { + data[i].r=0.0; + data[i].i=0.0; + } + for (i=0; i<numsamp; i++) + data[i].r=A*cos(2.0*PI*freq*i/fs - phase*PI/180); +#endif +#ifndef GEN + for (i=0; i<N; i++) + { + fscanf(infile, "%lf", &data[i].r); + data[i].i=0.0; + } +#endif + + gettimeofday(&start, (struct timezone *) 0); + if (radix==2) radix2(data, N); + if (radix==4) radix4(data, N); + gettimeofday(&end, (struct timezone *) 0); + totaltime=(end.tv_sec*1000000 + end.tv_usec)-(start.tv_sec*1000000 + + start.tv_usec); + if (radix==2) bit_reverse_reorder(data, N); + if (radix==4) bit_r4_reorder(data, N); + + if (!dotime) + for (i=0; i<N; i++) + printf("%f\n", sqrt(data[i].r*data[i].r + + data[i].i*data[i].i)); + else + printf("%ld us\n\n", totaltime); + +#ifndef GEN + fclose(infile); +#endif +} + + + diff --git a/nyqsrc/fftw.h b/nyqsrc/fftw.h new file mode 100644 index 0000000..1ba148a --- /dev/null +++ b/nyqsrc/fftw.h @@ -0,0 +1,412 @@ +/* -*- C -*- */ +/* + * Copyright (c) 1997-1999 Massachusetts Institute of Technology + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * + */ + +/* fftw.h -- system-wide definitions */ +/* $Id: fftw.h,v 1.1.1.1 2004/11/10 16:07:38 rbd Exp $ */ + +#ifndef FFTW_H +#define FFTW_H + +#include <stdlib.h> +#include <stdio.h> + +#ifdef __cplusplus +extern "C" { +#endif /* __cplusplus */ + +/* Define for using single precision */ +/* + * If you can, use configure --enable-float instead of changing this + * flag directly + */ +/* #undef FFTW_ENABLE_FLOAT */ + +/* our real numbers */ +#ifdef FFTW_ENABLE_FLOAT +typedef float fftw_real; +#else +typedef double fftw_real; +#endif + +/********************************************* + * Complex numbers and operations + *********************************************/ +typedef struct { + fftw_real re, im; +} fftw_complex; + +#define c_re(c) ((c).re) +#define c_im(c) ((c).im) + +typedef enum { + FFTW_FORWARD = -1, FFTW_BACKWARD = 1 +} fftw_direction; + +/* backward compatibility with FFTW-1.3 */ +typedef fftw_complex FFTW_COMPLEX; +typedef fftw_real FFTW_REAL; + +#ifndef FFTW_1_0_COMPATIBILITY +#define FFTW_1_0_COMPATIBILITY 0 +#endif + +#if FFTW_1_0_COMPATIBILITY +/* backward compatibility with FFTW-1.0 */ +#define REAL fftw_real +#define COMPLEX fftw_complex +#endif + +/********************************************* + * Success or failure status + *********************************************/ + +typedef enum { + FFTW_SUCCESS = 0, FFTW_FAILURE = -1 +} fftw_status; + +/********************************************* + * Codelets + *********************************************/ +typedef void (fftw_notw_codelet) + (const fftw_complex *, fftw_complex *, int, int); +typedef void (fftw_twiddle_codelet) + (fftw_complex *, const fftw_complex *, int, + int, int); +typedef void (fftw_generic_codelet) + (fftw_complex *, const fftw_complex *, int, + int, int, int); +typedef void (fftw_real2hc_codelet) + (const fftw_real *, fftw_real *, fftw_real *, + int, int, int); +typedef void (fftw_hc2real_codelet) + (const fftw_real *, const fftw_real *, + fftw_real *, int, int, int); +typedef void (fftw_hc2hc_codelet) + (fftw_real *, const fftw_complex *, + int, int, int); +typedef void (fftw_rgeneric_codelet) + (fftw_real *, const fftw_complex *, int, + int, int, int); + +/********************************************* + * Configurations + *********************************************/ +/* + * A configuration is a database of all known codelets + */ + +enum fftw_node_type { + FFTW_NOTW, FFTW_TWIDDLE, FFTW_GENERIC, FFTW_RADER, + FFTW_REAL2HC, FFTW_HC2REAL, FFTW_HC2HC, FFTW_RGENERIC +}; + +/* description of a codelet */ +typedef struct { + const char *name; /* name of the codelet */ + void (*codelet) (); /* pointer to the codelet itself */ + int size; /* size of the codelet */ + fftw_direction dir; /* direction */ + enum fftw_node_type type; /* TWIDDLE or NO_TWIDDLE */ + int signature; /* unique id */ + int ntwiddle; /* number of twiddle factors */ + const int *twiddle_order; /* + * array that determines the order + * in which the codelet expects + * the twiddle factors + */ +} fftw_codelet_desc; + +/* On Win32, you need to do funny things to access global variables + in shared libraries. Thanks to Andrew Sterian for this hack. */ +#if defined(__WIN32__) || defined(WIN32) || defined(_WINDOWS) +# if defined(BUILD_FFTW_DLL) +# define DL_IMPORT(type) __declspec(dllexport) type +# elif defined(USE_FFTW_DLL) +# define DL_IMPORT(type) __declspec(dllimport) type +# else +# define DL_IMPORT(type) type +# endif +#else +# define DL_IMPORT(type) type +#endif + +extern DL_IMPORT(const char *) fftw_version; + +/***************************** + * Plans + *****************************/ +/* + * A plan is a sequence of reductions to compute a FFT of + * a given size. At each step, the FFT algorithm can: + * + * 1) apply a notw codelet, or + * 2) recurse and apply a twiddle codelet, or + * 3) apply the generic codelet. + */ + +/* structure that contains twiddle factors */ +typedef struct fftw_twiddle_struct { + int n; + const fftw_codelet_desc *cdesc; + fftw_complex *twarray; + struct fftw_twiddle_struct *next; + int refcnt; +} fftw_twiddle; + +typedef struct fftw_rader_data_struct { + struct fftw_plan_struct *plan; + fftw_complex *omega; + int g, ginv; + int p, flags, refcount; + struct fftw_rader_data_struct *next; + fftw_codelet_desc *cdesc; +} fftw_rader_data; + +typedef void (fftw_rader_codelet) + (fftw_complex *, const fftw_complex *, int, + int, int, fftw_rader_data *); + +/* structure that holds all the data needed for a given step */ +typedef struct fftw_plan_node_struct { + enum fftw_node_type type; + + union { + /* nodes of type FFTW_NOTW */ + struct { + int size; + fftw_notw_codelet *codelet; + const fftw_codelet_desc *codelet_desc; + } notw; + + /* nodes of type FFTW_TWIDDLE */ + struct { + int size; + fftw_twiddle_codelet *codelet; + fftw_twiddle *tw; + struct fftw_plan_node_struct *recurse; + const fftw_codelet_desc *codelet_desc; + } twiddle; + + /* nodes of type FFTW_GENERIC */ + struct { + int size; + fftw_generic_codelet *codelet; + fftw_twiddle *tw; + struct fftw_plan_node_struct *recurse; + } generic; + + /* nodes of type FFTW_RADER */ + struct { + int size; + fftw_rader_codelet *codelet; + fftw_rader_data *rader_data; + fftw_twiddle *tw; + struct fftw_plan_node_struct *recurse; + } rader; + + /* nodes of type FFTW_REAL2HC */ + struct { + int size; + fftw_real2hc_codelet *codelet; + const fftw_codelet_desc *codelet_desc; + } real2hc; + + /* nodes of type FFTW_HC2REAL */ + struct { + int size; + fftw_hc2real_codelet *codelet; + const fftw_codelet_desc *codelet_desc; + } hc2real; + + /* nodes of type FFTW_HC2HC */ + struct { + int size; + fftw_direction dir; + fftw_hc2hc_codelet *codelet; + fftw_twiddle *tw; + struct fftw_plan_node_struct *recurse; + const fftw_codelet_desc *codelet_desc; + } hc2hc; + + /* nodes of type FFTW_RGENERIC */ + struct { + int size; + fftw_direction dir; + fftw_rgeneric_codelet *codelet; + fftw_twiddle *tw; + struct fftw_plan_node_struct *recurse; + } rgeneric; + } nodeu; + + int refcnt; +} fftw_plan_node; + +struct fftw_plan_struct { + int n; + int refcnt; + fftw_direction dir; + int flags; + int wisdom_signature; + enum fftw_node_type wisdom_type; + struct fftw_plan_struct *next; + fftw_plan_node *root; + double cost; +}; + +/* a plan is just an array of instructions */ +typedef struct fftw_plan_struct *fftw_plan; + +/* flags for the planner */ +#define FFTW_ESTIMATE (0) +#define FFTW_MEASURE (1) + +#define FFTW_OUT_OF_PLACE (0) +#define FFTW_IN_PLACE (8) +#define FFTW_USE_WISDOM (16) + +#define FFTW_THREADSAFE (128) /* guarantee plan is read-only so that the + same plan can be used in parallel by + multiple threads */ + +#define FFTWND_FORCE_BUFFERED (256) /* internal, undocumented flag */ + +extern fftw_plan fftw_create_plan_specific(int n, fftw_direction dir, + int flags, + fftw_complex *in, int istride, + fftw_complex *out, int ostride); +#define FFTW_HAS_PLAN_SPECIFIC +extern fftw_plan fftw_create_plan(int n, fftw_direction dir, int flags); +extern void fftw_print_plan(fftw_plan plan); +extern void fftw_destroy_plan(fftw_plan plan); +extern void fftw(fftw_plan plan, int howmany, fftw_complex *in, int istride, + int idist, fftw_complex *out, int ostride, int odist); +extern void fftw_one(fftw_plan plan, fftw_complex *in, fftw_complex *out); +extern void fftw_die(const char *s); +extern void *fftw_malloc(size_t n); +extern void fftw_free(void *p); +extern void fftw_check_memory_leaks(void); +extern void fftw_print_max_memory_usage(void); + +typedef void *(*fftw_malloc_type_function) (size_t n); +typedef void (*fftw_free_type_function) (void *p); +typedef void (*fftw_die_type_function) (const char *errString); +extern DL_IMPORT(fftw_malloc_type_function) fftw_malloc_hook; +extern DL_IMPORT(fftw_free_type_function) fftw_free_hook; +extern DL_IMPORT(fftw_die_type_function) fftw_die_hook; + +extern size_t fftw_sizeof_fftw_real(void); + +/* Wisdom: */ +/* + * define this symbol so that users know we are using a version of FFTW + * with wisdom + */ +#define FFTW_HAS_WISDOM +extern void fftw_forget_wisdom(void); +extern void fftw_export_wisdom(void (*emitter) (char c, void *), void *data); +extern fftw_status fftw_import_wisdom(int (*g) (void *), void *data); +extern void fftw_export_wisdom_to_file(FILE *output_file); +extern fftw_status fftw_import_wisdom_from_file(FILE *input_file); +extern char *fftw_export_wisdom_to_string(void); +extern fftw_status fftw_import_wisdom_from_string(const char *input_string); + +/* + * define symbol so we know this function is available (it is not in + * older FFTWs) + */ +#define FFTW_HAS_FPRINT_PLAN +extern void fftw_fprint_plan(FILE *f, fftw_plan plan); + +/***************************** + * N-dimensional code + *****************************/ +typedef struct { + int is_in_place; /* 1 if for in-place FFTs, 0 otherwise */ + + int rank; /* + * the rank (number of dimensions) of the + * array to be FFTed + */ + int *n; /* + * the dimensions of the array to the + * FFTed + */ + fftw_direction dir; + + int *n_before; /* + * n_before[i] = product of n[j] for j < i + */ + int *n_after; /* n_after[i] = product of n[j] for j > i */ + + fftw_plan *plans; /* 1d fftw plans for each dimension */ + + int nbuffers, nwork; + fftw_complex *work; /* + * work array big enough to hold + * nbuffers+1 of the largest dimension + * (has nwork elements) + */ +} fftwnd_data; + +typedef fftwnd_data *fftwnd_plan; + +/* Initializing the FFTWND plan: */ +extern fftwnd_plan fftw2d_create_plan(int nx, int ny, fftw_direction dir, + int flags); +extern fftwnd_plan fftw3d_create_plan(int nx, int ny, int nz, + fftw_direction dir, int flags); +extern fftwnd_plan fftwnd_create_plan(int rank, const int *n, + fftw_direction dir, + int flags); + +extern fftwnd_plan fftw2d_create_plan_specific(int nx, int ny, + fftw_direction dir, + int flags, + fftw_complex *in, int istride, + fftw_complex *out, int ostride); +extern fftwnd_plan fftw3d_create_plan_specific(int nx, int ny, int nz, + fftw_direction dir, int flags, + fftw_complex *in, int istride, + fftw_complex *out, int ostride); +extern fftwnd_plan fftwnd_create_plan_specific(int rank, const int *n, + fftw_direction dir, + int flags, + fftw_complex *in, int istride, + fftw_complex *out, int ostride); + +/* Freeing the FFTWND plan: */ +extern void fftwnd_destroy_plan(fftwnd_plan plan); + +/* Printing the plan: */ +extern void fftwnd_fprint_plan(FILE *f, fftwnd_plan p); +extern void fftwnd_print_plan(fftwnd_plan p); +#define FFTWND_HAS_PRINT_PLAN + +/* Computing the N-Dimensional FFT */ +extern void fftwnd(fftwnd_plan plan, int howmany, + fftw_complex *in, int istride, int idist, + fftw_complex *out, int ostride, int odist); +extern void fftwnd_one(fftwnd_plan p, fftw_complex *in, fftw_complex *out); + +#ifdef __cplusplus +} /* extern "C" */ + +#endif /* __cplusplus */ +#endif /* FFTW_H */ diff --git a/nyqsrc/fresample.h b/nyqsrc/fresample.h new file mode 100644 index 0000000..be1a199 --- /dev/null +++ b/nyqsrc/fresample.h @@ -0,0 +1,75 @@ +/* + * FILE: fresample.h + * + * The configuration constants below govern + * the number of bits in the input sample and filter coefficients, the + * number of bits to the right of the binary-point for fixed-point math, etc. + * + */ + +/* #include "stdefs.h" */ + +typedef double SAMPLE_TYPE; +#define SCALE_FACTOR_TO_SHORT 32767 + +/* Conversion constants */ +#define Nhc 8 +/* #define Na 7 */ +/* #define Np (Nhc+Na)*/ +#define Npc (1<<Nhc) +/* #define Amask ((1<<Na)-1) */ +/* #define Pmask ((1<<Np)-1) */ +/* #define Nh 16 */ +/* #define Nb 16 */ +/* #define Nhxn 14 */ +/* #define Nhg (Nh-Nhxn) */ +/* #define NLpScl 13 */ + +/* Description of constants: + * + * Npc - is the number of look-up values available for the lowpass filter + * between the beginning of its impulse response and the "cutoff time" + * of the filter. The cutoff time is defined as the reciprocal of the + * lowpass-filter cut off frequence in Hz. For example, if the + * lowpass filter were a sinc function, Npc would be the index of the + * impulse-response lookup-table corresponding to the first zero- + * crossing of the sinc function. (The inverse first zero-crossing + * time of a sinc function equals its nominal cutoff frequency in Hz.) + * Npc must be a power of 2 due to the details of the current + * implementation. The default value of 512 is sufficiently high that + * using linear interpolation to fill in between the table entries + * gives approximately 16-bit accuracy in filter coefficients. + * + * Nhc - is log base 2 of Npc. + * + * Na - is the number of bits devoted to linear interpolation of the + * filter coefficients. + * + * Np - is Na + Nhc, the number of bits to the right of the binary point + * in the integer "time" variable. To the left of the point, it indexes + * the input array (X), and to the right, it is interpreted as a number + * between 0 and 1 sample of the input X. Np must be less than 16 in + * this implementation. + * + * Nh - is the number of bits in the filter coefficients. The sum of Nh and + * the number of bits in the input data (typically 16) cannot exceed 32. + * Thus Nh should be 16. The largest filter coefficient should nearly + * fill 16 bits (32767). + * + * Nb - is the number of bits in the input data. The sum of Nb and Nh cannot + * exceed 32. + * + * Nhxn - is the number of bits to right shift after multiplying each input + * sample times a filter coefficient. It can be as great as Nh and as + * small as 0. Nhxn = Nh-2 gives 2 guard bits in the multiply-add + * accumulation. If Nhxn=0, the accumulation will soon overflow 32 bits. + * + * Nhg - is the number of guard bits in mpy-add accumulation (equal to Nh-Nhxn) + * + * NLpScl - is the number of bits allocated to the unity-gain normalization + * factor. The output of the lowpass filter is multiplied by LpScl and + * then right-shifted NLpScl bits. To avoid overflow, we must have + * Nb+Nhg+NLpScl < 32. + */ + + diff --git a/nyqsrc/fsmallfilter.h b/nyqsrc/fsmallfilter.h new file mode 100644 index 0000000..8cd6e12 --- /dev/null +++ b/nyqsrc/fsmallfilter.h @@ -0,0 +1,3079 @@ +/* Included by resamplesubs.c */ +#define SMALL_FILTER_NMULT 13 +#define SMALL_FILTER_SCALE 13128 /* Unity-gain scale factor */ +#define SMALL_FILTER_NWING 1536 /* Filter table length */ +static float SMALL_FILTER_IMP[] /* Impulse response */ = { +32767.0F, +32766.0F, +32765.0F, +32762.0F, +32758.0F, +32753.0F, +32747.0F, +32739.0F, +32731.0F, +32722.0F, +32711.0F, +32699.0F, +32686.0F, +32672.0F, +32657.0F, +32641.0F, +32623.0F, +32605.0F, +32585.0F, +32565.0F, +32543.0F, +32520.0F, +32496.0F, +32471.0F, +32445.0F, +32417.0F, +32389.0F, +32359.0F, +32329.0F, +32297.0F, +32264.0F, +32230.0F, +32195.0F, +32159.0F, +32122.0F, +32084.0F, +32044.0F, +32004.0F, +31962.0F, +31920.0F, +31876.0F, +31832.0F, +31786.0F, +31739.0F, +31691.0F, +31642.0F, +31592.0F, +31541.0F, +31489.0F, +31436.0F, +31382.0F, +31327.0F, +31271.0F, +31214.0F, +31156.0F, +31096.0F, +31036.0F, +30975.0F, +30913.0F, +30849.0F, +30785.0F, +30720.0F, +30654.0F, +30586.0F, +30518.0F, +30449.0F, +30379.0F, +30308.0F, +30236.0F, +30163.0F, +30089.0F, +30014.0F, +29938.0F, +29861.0F, +29784.0F, +29705.0F, +29625.0F, +29545.0F, +29464.0F, +29381.0F, +29298.0F, +29214.0F, +29129.0F, +29043.0F, +28956.0F, +28869.0F, +28780.0F, +28691.0F, +28601.0F, +28510.0F, +28418.0F, +28325.0F, +28232.0F, +28137.0F, +28042.0F, +27946.0F, +27849.0F, +27752.0F, +27653.0F, +27554.0F, +27454.0F, +27353.0F, +27252.0F, +27149.0F, +27046.0F, +26943.0F, +26838.0F, +26733.0F, +26627.0F, +26520.0F, +26413.0F, +26305.0F, +26196.0F, +26086.0F, +25976.0F, +25865.0F, +25753.0F, +25641.0F, +25528.0F, +25415.0F, +25301.0F, +25186.0F, +25070.0F, +24954.0F, +24838.0F, +24720.0F, +24602.0F, +24484.0F, +24365.0F, +24245.0F, +24125.0F, +24004.0F, +23883.0F, +23761.0F, +23639.0F, +23516.0F, +23392.0F, +23268.0F, +23144.0F, +23019.0F, +22893.0F, +22767.0F, +22641.0F, +22514.0F, +22386.0F, +22259.0F, +22130.0F, +22001.0F, +21872.0F, +21743.0F, +21613.0F, +21482.0F, +21352.0F, +21220.0F, +21089.0F, +20957.0F, +20825.0F, +20692.0F, +20559.0F, +20426.0F, +20292.0F, +20158.0F, +20024.0F, +19889.0F, +19754.0F, +19619.0F, +19483.0F, +19347.0F, +19211.0F, +19075.0F, +18939.0F, +18802.0F, +18665.0F, +18527.0F, +18390.0F, +18252.0F, +18114.0F, +17976.0F, +17838.0F, +17700.0F, +17561.0F, +17422.0F, +17283.0F, +17144.0F, +17005.0F, +16866.0F, +16726.0F, +16587.0F, +16447.0F, +16307.0F, +16167.0F, +16027.0F, +15887.0F, +15747.0F, +15607.0F, +15467.0F, +15327.0F, +15187.0F, +15046.0F, +14906.0F, +14766.0F, +14625.0F, +14485.0F, +14345.0F, +14205.0F, +14065.0F, +13924.0F, +13784.0F, +13644.0F, +13504.0F, +13364.0F, +13225.0F, +13085.0F, +12945.0F, +12806.0F, +12666.0F, +12527.0F, +12388.0F, +12249.0F, +12110.0F, +11971.0F, +11833.0F, +11694.0F, +11556.0F, +11418.0F, +11280.0F, +11142.0F, +11005.0F, +10867.0F, +10730.0F, +10594.0F, +10457.0F, +10321.0F, +10185.0F, +10049.0F, +9913.0F, +9778.0F, +9643.0F, +9508.0F, +9374.0F, +9239.0F, +9105.0F, +8972.0F, +8839.0F, +8706.0F, +8573.0F, +8441.0F, +8309.0F, +8177.0F, +8046.0F, +7915.0F, +7785.0F, +7655.0F, +7525.0F, +7396.0F, +7267.0F, +7138.0F, +7010.0F, +6882.0F, +6755.0F, +6628.0F, +6502.0F, +6376.0F, +6250.0F, +6125.0F, +6001.0F, +5876.0F, +5753.0F, +5630.0F, +5507.0F, +5385.0F, +5263.0F, +5141.0F, +5021.0F, +4900.0F, +4781.0F, +4661.0F, +4543.0F, +4425.0F, +4307.0F, +4190.0F, +4073.0F, +3957.0F, +3842.0F, +3727.0F, +3613.0F, +3499.0F, +3386.0F, +3273.0F, +3161.0F, +3050.0F, +2939.0F, +2828.0F, +2719.0F, +2610.0F, +2501.0F, +2394.0F, +2286.0F, +2180.0F, +2074.0F, +1968.0F, +1864.0F, +1760.0F, +1656.0F, +1554.0F, +1451.0F, +1350.0F, +1249.0F, +1149.0F, +1050.0F, +951.0F, +853.0F, +755.0F, +658.0F, +562.0F, +467.0F, +372.0F, +278.0F, +185.0F, +92.0F, +0.0F, +-90.0F, +-181.0F, +-271.0F, +-360.0F, +-448.0F, +-536.0F, +-623.0F, +-709.0F, +-795.0F, +-880.0F, +-964.0F, +-1047.0F, +-1130.0F, +-1212.0F, +-1293.0F, +-1373.0F, +-1453.0F, +-1532.0F, +-1610.0F, +-1688.0F, +-1764.0F, +-1840.0F, +-1916.0F, +-1990.0F, +-2064.0F, +-2137.0F, +-2209.0F, +-2281.0F, +-2351.0F, +-2421.0F, +-2491.0F, +-2559.0F, +-2627.0F, +-2694.0F, +-2760.0F, +-2825.0F, +-2890.0F, +-2954.0F, +-3017.0F, +-3080.0F, +-3141.0F, +-3202.0F, +-3262.0F, +-3322.0F, +-3380.0F, +-3438.0F, +-3495.0F, +-3551.0F, +-3607.0F, +-3662.0F, +-3716.0F, +-3769.0F, +-3821.0F, +-3873.0F, +-3924.0F, +-3974.0F, +-4024.0F, +-4072.0F, +-4120.0F, +-4167.0F, +-4214.0F, +-4259.0F, +-4304.0F, +-4348.0F, +-4392.0F, +-4434.0F, +-4476.0F, +-4517.0F, +-4558.0F, +-4597.0F, +-4636.0F, +-4674.0F, +-4712.0F, +-4748.0F, +-4784.0F, +-4819.0F, +-4854.0F, +-4887.0F, +-4920.0F, +-4953.0F, +-4984.0F, +-5015.0F, +-5045.0F, +-5074.0F, +-5103.0F, +-5131.0F, +-5158.0F, +-5184.0F, +-5210.0F, +-5235.0F, +-5259.0F, +-5283.0F, +-5306.0F, +-5328.0F, +-5349.0F, +-5370.0F, +-5390.0F, +-5409.0F, +-5428.0F, +-5446.0F, +-5463.0F, +-5480.0F, +-5496.0F, +-5511.0F, +-5526.0F, +-5540.0F, +-5553.0F, +-5566.0F, +-5578.0F, +-5589.0F, +-5600.0F, +-5610.0F, +-5619.0F, +-5628.0F, +-5636.0F, +-5643.0F, +-5650.0F, +-5656.0F, +-5662.0F, +-5667.0F, +-5671.0F, +-5674.0F, +-5678.0F, +-5680.0F, +-5682.0F, +-5683.0F, +-5684.0F, +-5684.0F, +-5683.0F, +-5682.0F, +-5680.0F, +-5678.0F, +-5675.0F, +-5672.0F, +-5668.0F, +-5663.0F, +-5658.0F, +-5652.0F, +-5646.0F, +-5639.0F, +-5632.0F, +-5624.0F, +-5616.0F, +-5607.0F, +-5597.0F, +-5587.0F, +-5577.0F, +-5566.0F, +-5554.0F, +-5542.0F, +-5529.0F, +-5516.0F, +-5503.0F, +-5489.0F, +-5474.0F, +-5459.0F, +-5444.0F, +-5428.0F, +-5412.0F, +-5395.0F, +-5378.0F, +-5360.0F, +-5342.0F, +-5323.0F, +-5304.0F, +-5284.0F, +-5264.0F, +-5244.0F, +-5223.0F, +-5202.0F, +-5180.0F, +-5158.0F, +-5136.0F, +-5113.0F, +-5090.0F, +-5066.0F, +-5042.0F, +-5018.0F, +-4993.0F, +-4968.0F, +-4943.0F, +-4917.0F, +-4891.0F, +-4864.0F, +-4838.0F, +-4810.0F, +-4783.0F, +-4755.0F, +-4727.0F, +-4698.0F, +-4670.0F, +-4640.0F, +-4611.0F, +-4581.0F, +-4551.0F, +-4521.0F, +-4490.0F, +-4460.0F, +-4428.0F, +-4397.0F, +-4365.0F, +-4333.0F, +-4301.0F, +-4269.0F, +-4236.0F, +-4203.0F, +-4170.0F, +-4137.0F, +-4103.0F, +-4069.0F, +-4035.0F, +-4001.0F, +-3966.0F, +-3932.0F, +-3897.0F, +-3862.0F, +-3827.0F, +-3791.0F, +-3755.0F, +-3720.0F, +-3684.0F, +-3648.0F, +-3611.0F, +-3575.0F, +-3538.0F, +-3502.0F, +-3465.0F, +-3428.0F, +-3390.0F, +-3353.0F, +-3316.0F, +-3278.0F, +-3241.0F, +-3203.0F, +-3165.0F, +-3127.0F, +-3089.0F, +-3051.0F, +-3013.0F, +-2974.0F, +-2936.0F, +-2898.0F, +-2859.0F, +-2820.0F, +-2782.0F, +-2743.0F, +-2704.0F, +-2666.0F, +-2627.0F, +-2588.0F, +-2549.0F, +-2510.0F, +-2471.0F, +-2432.0F, +-2393.0F, +-2354.0F, +-2315.0F, +-2276.0F, +-2237.0F, +-2198.0F, +-2159.0F, +-2120.0F, +-2081.0F, +-2042.0F, +-2003.0F, +-1964.0F, +-1925.0F, +-1886.0F, +-1847.0F, +-1808.0F, +-1770.0F, +-1731.0F, +-1692.0F, +-1654.0F, +-1615.0F, +-1577.0F, +-1538.0F, +-1500.0F, +-1462.0F, +-1424.0F, +-1386.0F, +-1348.0F, +-1310.0F, +-1272.0F, +-1234.0F, +-1197.0F, +-1159.0F, +-1122.0F, +-1084.0F, +-1047.0F, +-1010.0F, +-973.0F, +-936.0F, +-900.0F, +-863.0F, +-827.0F, +-790.0F, +-754.0F, +-718.0F, +-682.0F, +-646.0F, +-611.0F, +-575.0F, +-540.0F, +-505.0F, +-470.0F, +-435.0F, +-401.0F, +-366.0F, +-332.0F, +-298.0F, +-264.0F, +-230.0F, +-197.0F, +-163.0F, +-130.0F, +-97.0F, +-64.0F, +-31.0F, +0.0F, +32.0F, +64.0F, +96.0F, +128.0F, +159.0F, +190.0F, +221.0F, +252.0F, +283.0F, +313.0F, +343.0F, +373.0F, +403.0F, +432.0F, +462.0F, +491.0F, +519.0F, +548.0F, +576.0F, +604.0F, +632.0F, +660.0F, +687.0F, +714.0F, +741.0F, +768.0F, +794.0F, +821.0F, +847.0F, +872.0F, +898.0F, +923.0F, +948.0F, +972.0F, +997.0F, +1021.0F, +1045.0F, +1068.0F, +1092.0F, +1115.0F, +1138.0F, +1160.0F, +1183.0F, +1205.0F, +1227.0F, +1248.0F, +1270.0F, +1291.0F, +1311.0F, +1332.0F, +1352.0F, +1372.0F, +1392.0F, +1411.0F, +1430.0F, +1449.0F, +1468.0F, +1486.0F, +1504.0F, +1522.0F, +1539.0F, +1556.0F, +1573.0F, +1590.0F, +1607.0F, +1623.0F, +1639.0F, +1654.0F, +1669.0F, +1685.0F, +1699.0F, +1714.0F, +1728.0F, +1742.0F, +1756.0F, +1769.0F, +1782.0F, +1795.0F, +1808.0F, +1820.0F, +1832.0F, +1844.0F, +1855.0F, +1867.0F, +1878.0F, +1888.0F, +1899.0F, +1909.0F, +1919.0F, +1929.0F, +1938.0F, +1947.0F, +1956.0F, +1964.0F, +1973.0F, +1981.0F, +1989.0F, +1996.0F, +2003.0F, +2010.0F, +2017.0F, +2024.0F, +2030.0F, +2036.0F, +2042.0F, +2047.0F, +2052.0F, +2057.0F, +2062.0F, +2066.0F, +2071.0F, +2074.0F, +2078.0F, +2082.0F, +2085.0F, +2088.0F, +2091.0F, +2093.0F, +2095.0F, +2097.0F, +2099.0F, +2101.0F, +2102.0F, +2103.0F, +2104.0F, +2104.0F, +2105.0F, +2105.0F, +2105.0F, +2104.0F, +2104.0F, +2103.0F, +2102.0F, +2101.0F, +2100.0F, +2098.0F, +2096.0F, +2094.0F, +2092.0F, +2089.0F, +2087.0F, +2084.0F, +2081.0F, +2077.0F, +2074.0F, +2070.0F, +2066.0F, +2062.0F, +2058.0F, +2053.0F, +2048.0F, +2043.0F, +2038.0F, +2033.0F, +2028.0F, +2022.0F, +2016.0F, +2010.0F, +2004.0F, +1998.0F, +1991.0F, +1984.0F, +1978.0F, +1970.0F, +1963.0F, +1956.0F, +1948.0F, +1941.0F, +1933.0F, +1925.0F, +1917.0F, +1908.0F, +1900.0F, +1891.0F, +1882.0F, +1873.0F, +1864.0F, +1855.0F, +1846.0F, +1836.0F, +1826.0F, +1817.0F, +1807.0F, +1797.0F, +1787.0F, +1776.0F, +1766.0F, +1755.0F, +1745.0F, +1734.0F, +1723.0F, +1712.0F, +1701.0F, +1689.0F, +1678.0F, +1667.0F, +1655.0F, +1643.0F, +1632.0F, +1620.0F, +1608.0F, +1596.0F, +1583.0F, +1571.0F, +1559.0F, +1546.0F, +1534.0F, +1521.0F, +1509.0F, +1496.0F, +1483.0F, +1470.0F, +1457.0F, +1444.0F, +1431.0F, +1417.0F, +1404.0F, +1391.0F, +1377.0F, +1364.0F, +1350.0F, +1337.0F, +1323.0F, +1309.0F, +1296.0F, +1282.0F, +1268.0F, +1254.0F, +1240.0F, +1226.0F, +1212.0F, +1198.0F, +1184.0F, +1170.0F, +1156.0F, +1141.0F, +1127.0F, +1113.0F, +1099.0F, +1084.0F, +1070.0F, +1056.0F, +1041.0F, +1027.0F, +1013.0F, +998.0F, +984.0F, +969.0F, +955.0F, +940.0F, +926.0F, +911.0F, +897.0F, +882.0F, +868.0F, +854.0F, +839.0F, +825.0F, +810.0F, +796.0F, +781.0F, +767.0F, +753.0F, +738.0F, +724.0F, +709.0F, +695.0F, +681.0F, +667.0F, +652.0F, +638.0F, +624.0F, +610.0F, +596.0F, +581.0F, +567.0F, +553.0F, +539.0F, +525.0F, +511.0F, +498.0F, +484.0F, +470.0F, +456.0F, +442.0F, +429.0F, +415.0F, +402.0F, +388.0F, +375.0F, +361.0F, +348.0F, +335.0F, +321.0F, +308.0F, +295.0F, +282.0F, +269.0F, +256.0F, +243.0F, +230.0F, +217.0F, +205.0F, +192.0F, +180.0F, +167.0F, +155.0F, +142.0F, +130.0F, +118.0F, +106.0F, +94.0F, +82.0F, +70.0F, +58.0F, +46.0F, +35.0F, +23.0F, +11.0F, +0.0F, +-10.0F, +-22.0F, +-33.0F, +-44.0F, +-55.0F, +-66.0F, +-77.0F, +-87.0F, +-98.0F, +-109.0F, +-119.0F, +-130.0F, +-140.0F, +-150.0F, +-160.0F, +-170.0F, +-180.0F, +-190.0F, +-200.0F, +-209.0F, +-219.0F, +-228.0F, +-238.0F, +-247.0F, +-256.0F, +-265.0F, +-274.0F, +-283.0F, +-292.0F, +-301.0F, +-309.0F, +-318.0F, +-326.0F, +-335.0F, +-343.0F, +-351.0F, +-359.0F, +-367.0F, +-375.0F, +-382.0F, +-390.0F, +-397.0F, +-405.0F, +-412.0F, +-419.0F, +-426.0F, +-433.0F, +-440.0F, +-447.0F, +-454.0F, +-460.0F, +-467.0F, +-473.0F, +-479.0F, +-486.0F, +-492.0F, +-498.0F, +-504.0F, +-509.0F, +-515.0F, +-521.0F, +-526.0F, +-531.0F, +-537.0F, +-542.0F, +-547.0F, +-552.0F, +-557.0F, +-561.0F, +-566.0F, +-571.0F, +-575.0F, +-579.0F, +-584.0F, +-588.0F, +-592.0F, +-596.0F, +-600.0F, +-604.0F, +-607.0F, +-611.0F, +-614.0F, +-618.0F, +-621.0F, +-624.0F, +-627.0F, +-630.0F, +-633.0F, +-636.0F, +-638.0F, +-641.0F, +-644.0F, +-646.0F, +-648.0F, +-651.0F, +-653.0F, +-655.0F, +-657.0F, +-658.0F, +-660.0F, +-662.0F, +-664.0F, +-665.0F, +-666.0F, +-668.0F, +-669.0F, +-670.0F, +-671.0F, +-672.0F, +-673.0F, +-674.0F, +-675.0F, +-675.0F, +-676.0F, +-676.0F, +-677.0F, +-677.0F, +-677.0F, +-677.0F, +-677.0F, +-677.0F, +-677.0F, +-677.0F, +-677.0F, +-676.0F, +-676.0F, +-675.0F, +-675.0F, +-674.0F, +-674.0F, +-673.0F, +-672.0F, +-671.0F, +-670.0F, +-669.0F, +-668.0F, +-667.0F, +-665.0F, +-664.0F, +-663.0F, +-661.0F, +-660.0F, +-658.0F, +-656.0F, +-654.0F, +-653.0F, +-651.0F, +-649.0F, +-647.0F, +-645.0F, +-643.0F, +-641.0F, +-638.0F, +-636.0F, +-634.0F, +-631.0F, +-629.0F, +-626.0F, +-624.0F, +-621.0F, +-619.0F, +-616.0F, +-613.0F, +-610.0F, +-608.0F, +-605.0F, +-602.0F, +-599.0F, +-596.0F, +-593.0F, +-589.0F, +-586.0F, +-583.0F, +-580.0F, +-576.0F, +-573.0F, +-570.0F, +-566.0F, +-563.0F, +-559.0F, +-556.0F, +-552.0F, +-549.0F, +-545.0F, +-541.0F, +-538.0F, +-534.0F, +-530.0F, +-526.0F, +-522.0F, +-519.0F, +-515.0F, +-511.0F, +-507.0F, +-503.0F, +-499.0F, +-495.0F, +-491.0F, +-487.0F, +-482.0F, +-478.0F, +-474.0F, +-470.0F, +-466.0F, +-462.0F, +-457.0F, +-453.0F, +-449.0F, +-445.0F, +-440.0F, +-436.0F, +-432.0F, +-427.0F, +-423.0F, +-419.0F, +-414.0F, +-410.0F, +-406.0F, +-401.0F, +-397.0F, +-392.0F, +-388.0F, +-383.0F, +-379.0F, +-375.0F, +-370.0F, +-366.0F, +-361.0F, +-357.0F, +-352.0F, +-348.0F, +-343.0F, +-339.0F, +-334.0F, +-330.0F, +-325.0F, +-321.0F, +-316.0F, +-312.0F, +-307.0F, +-303.0F, +-298.0F, +-294.0F, +-290.0F, +-285.0F, +-281.0F, +-276.0F, +-272.0F, +-267.0F, +-263.0F, +-259.0F, +-254.0F, +-250.0F, +-245.0F, +-241.0F, +-237.0F, +-232.0F, +-228.0F, +-224.0F, +-219.0F, +-215.0F, +-211.0F, +-207.0F, +-202.0F, +-198.0F, +-194.0F, +-190.0F, +-185.0F, +-181.0F, +-177.0F, +-173.0F, +-169.0F, +-165.0F, +-161.0F, +-157.0F, +-153.0F, +-149.0F, +-145.0F, +-141.0F, +-137.0F, +-133.0F, +-129.0F, +-125.0F, +-121.0F, +-117.0F, +-113.0F, +-110.0F, +-106.0F, +-102.0F, +-98.0F, +-95.0F, +-91.0F, +-87.0F, +-84.0F, +-80.0F, +-77.0F, +-73.0F, +-69.0F, +-66.0F, +-62.0F, +-59.0F, +-56.0F, +-52.0F, +-49.0F, +-46.0F, +-42.0F, +-39.0F, +-36.0F, +-32.0F, +-29.0F, +-26.0F, +-23.0F, +-20.0F, +-17.0F, +-14.0F, +-11.0F, +-8.0F, +-5.0F, +-2.0F, +0.0F, +3.0F, +6.0F, +8.0F, +11.0F, +14.0F, +17.0F, +19.0F, +22.0F, +25.0F, +27.0F, +30.0F, +32.0F, +35.0F, +37.0F, +40.0F, +42.0F, +44.0F, +47.0F, +49.0F, +51.0F, +54.0F, +56.0F, +58.0F, +60.0F, +62.0F, +64.0F, +66.0F, +68.0F, +70.0F, +72.0F, +74.0F, +76.0F, +78.0F, +80.0F, +82.0F, +83.0F, +85.0F, +87.0F, +89.0F, +90.0F, +92.0F, +93.0F, +95.0F, +96.0F, +98.0F, +99.0F, +101.0F, +102.0F, +104.0F, +105.0F, +106.0F, +107.0F, +109.0F, +110.0F, +111.0F, +112.0F, +113.0F, +114.0F, +116.0F, +117.0F, +118.0F, +119.0F, +120.0F, +120.0F, +121.0F, +122.0F, +123.0F, +124.0F, +125.0F, +125.0F, +126.0F, +127.0F, +128.0F, +128.0F, +129.0F, +129.0F, +130.0F, +131.0F, +131.0F, +132.0F, +132.0F, +133.0F, +133.0F, +133.0F, +134.0F, +134.0F, +134.0F, +135.0F, +135.0F, +135.0F, +135.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +137.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +136.0F, +135.0F, +135.0F, +135.0F, +135.0F, +135.0F, +134.0F, +134.0F, +134.0F, +133.0F, +133.0F, +133.0F, +132.0F, +132.0F, +131.0F, +131.0F, +131.0F, +130.0F, +130.0F, +129.0F, +129.0F, +128.0F, +128.0F, +127.0F, +127.0F, +126.0F, +125.0F, +125.0F, +124.0F, +124.0F, +123.0F, +122.0F, +122.0F, +121.0F, +120.0F, +120.0F, +119.0F, +118.0F, +118.0F, +117.0F, +116.0F, +115.0F, +115.0F, +114.0F, +113.0F, +112.0F, +112.0F, +111.0F, +110.0F, +109.0F, +108.0F, +108.0F, +107.0F, +106.0F, +105.0F, +104.0F, +103.0F, +103.0F, +102.0F, +101.0F, +100.0F, +99.0F, +98.0F, +97.0F, +96.0F, +96.0F, +95.0F, +94.0F, +93.0F, +92.0F, +91.0F, +90.0F, +89.0F, +88.0F, +87.0F, +87.0F, +86.0F, +85.0F, +84.0F, +83.0F, +82.0F, +81.0F, +80.0F, +79.0F, +78.0F, +77.0F, +76.0F, +76.0F, +75.0F, +74.0F, +73.0F, +72.0F, +71.0F, +70.0F, +69.0F, +68.0F, +67.0F, +66.0F, +65.0F, +65.0F, +64.0F, +63.0F, +62.0F, +61.0F, +60.0F, +59.0F, +58.0F, +57.0F, +57.0F, +56.0F, +55.0F, +54.0F, +53.0F, +52.0F, +51.0F, +51.0F, +50.0F, +49.0F, +48.0F, +47.0F, +46.0F, +46.0F, +45.0F, +44.0F, +43.0F, +42.0F, +42.0F, +41.0F, +40.0F, +39.0F, +38.0F, +38.0F, +37.0F, +36.0F, +35.0F, +35.0F, +34.0F, +33.0F, +33.0F, +32.0F, +31.0F, +30.0F, +30.0F, +29.0F, +28.0F, +28.0F}; + +static float SMALL_FILTER_IMPD[] = { +-1.0F, +-1.0F, +-3.0F, +-4.0F, +-5.0F, +-6.0F, +-8.0F, +-8.0F, +-9.0F, +-11.0F, +-12.0F, +-13.0F, +-14.0F, +-15.0F, +-16.0F, +-18.0F, +-18.0F, +-20.0F, +-20.0F, +-22.0F, +-23.0F, +-24.0F, +-25.0F, +-26.0F, +-28.0F, +-28.0F, +-30.0F, +-30.0F, +-32.0F, +-33.0F, +-34.0F, +-35.0F, +-36.0F, +-37.0F, +-38.0F, +-40.0F, +-40.0F, +-42.0F, +-42.0F, +-44.0F, +-44.0F, +-46.0F, +-47.0F, +-48.0F, +-49.0F, +-50.0F, +-51.0F, +-52.0F, +-53.0F, +-54.0F, +-55.0F, +-56.0F, +-57.0F, +-58.0F, +-60.0F, +-60.0F, +-61.0F, +-62.0F, +-64.0F, +-64.0F, +-65.0F, +-66.0F, +-68.0F, +-68.0F, +-69.0F, +-70.0F, +-71.0F, +-72.0F, +-73.0F, +-74.0F, +-75.0F, +-76.0F, +-77.0F, +-77.0F, +-79.0F, +-80.0F, +-80.0F, +-81.0F, +-83.0F, +-83.0F, +-84.0F, +-85.0F, +-86.0F, +-87.0F, +-87.0F, +-89.0F, +-89.0F, +-90.0F, +-91.0F, +-92.0F, +-93.0F, +-93.0F, +-95.0F, +-95.0F, +-96.0F, +-97.0F, +-97.0F, +-99.0F, +-99.0F, +-100.0F, +-101.0F, +-101.0F, +-103.0F, +-103.0F, +-103.0F, +-105.0F, +-105.0F, +-106.0F, +-107.0F, +-107.0F, +-108.0F, +-109.0F, +-110.0F, +-110.0F, +-111.0F, +-112.0F, +-112.0F, +-113.0F, +-113.0F, +-114.0F, +-115.0F, +-116.0F, +-116.0F, +-116.0F, +-118.0F, +-118.0F, +-118.0F, +-119.0F, +-120.0F, +-120.0F, +-121.0F, +-121.0F, +-122.0F, +-122.0F, +-123.0F, +-124.0F, +-124.0F, +-124.0F, +-125.0F, +-126.0F, +-126.0F, +-126.0F, +-127.0F, +-128.0F, +-127.0F, +-129.0F, +-129.0F, +-129.0F, +-129.0F, +-130.0F, +-131.0F, +-130.0F, +-132.0F, +-131.0F, +-132.0F, +-132.0F, +-133.0F, +-133.0F, +-133.0F, +-134.0F, +-134.0F, +-134.0F, +-135.0F, +-135.0F, +-135.0F, +-136.0F, +-136.0F, +-136.0F, +-136.0F, +-136.0F, +-137.0F, +-137.0F, +-138.0F, +-137.0F, +-138.0F, +-138.0F, +-138.0F, +-138.0F, +-138.0F, +-139.0F, +-139.0F, +-139.0F, +-139.0F, +-139.0F, +-139.0F, +-140.0F, +-139.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-141.0F, +-140.0F, +-140.0F, +-141.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-141.0F, +-140.0F, +-140.0F, +-140.0F, +-140.0F, +-139.0F, +-140.0F, +-140.0F, +-139.0F, +-140.0F, +-139.0F, +-139.0F, +-139.0F, +-139.0F, +-139.0F, +-138.0F, +-139.0F, +-138.0F, +-138.0F, +-138.0F, +-138.0F, +-137.0F, +-138.0F, +-137.0F, +-136.0F, +-137.0F, +-136.0F, +-136.0F, +-136.0F, +-136.0F, +-135.0F, +-135.0F, +-135.0F, +-134.0F, +-135.0F, +-134.0F, +-133.0F, +-133.0F, +-133.0F, +-133.0F, +-132.0F, +-132.0F, +-132.0F, +-131.0F, +-131.0F, +-130.0F, +-130.0F, +-130.0F, +-129.0F, +-129.0F, +-129.0F, +-128.0F, +-128.0F, +-127.0F, +-127.0F, +-126.0F, +-126.0F, +-126.0F, +-125.0F, +-124.0F, +-125.0F, +-123.0F, +-123.0F, +-123.0F, +-122.0F, +-122.0F, +-122.0F, +-120.0F, +-121.0F, +-119.0F, +-120.0F, +-118.0F, +-118.0F, +-118.0F, +-117.0F, +-117.0F, +-116.0F, +-115.0F, +-115.0F, +-114.0F, +-114.0F, +-113.0F, +-113.0F, +-112.0F, +-111.0F, +-111.0F, +-111.0F, +-109.0F, +-109.0F, +-109.0F, +-107.0F, +-108.0F, +-106.0F, +-106.0F, +-106.0F, +-104.0F, +-104.0F, +-104.0F, +-102.0F, +-103.0F, +-101.0F, +-101.0F, +-100.0F, +-99.0F, +-99.0F, +-98.0F, +-98.0F, +-97.0F, +-96.0F, +-95.0F, +-95.0F, +-94.0F, +-93.0F, +-93.0F, +-92.0F, +-90.0F, +-91.0F, +-90.0F, +-89.0F, +-88.0F, +-88.0F, +-87.0F, +-86.0F, +-86.0F, +-85.0F, +-84.0F, +-83.0F, +-83.0F, +-82.0F, +-81.0F, +-80.0F, +-80.0F, +-79.0F, +-78.0F, +-78.0F, +-76.0F, +-76.0F, +-76.0F, +-74.0F, +-74.0F, +-73.0F, +-72.0F, +-72.0F, +-70.0F, +-70.0F, +-70.0F, +-68.0F, +-68.0F, +-67.0F, +-66.0F, +-65.0F, +-65.0F, +-64.0F, +-63.0F, +-63.0F, +-61.0F, +-61.0F, +-60.0F, +-60.0F, +-58.0F, +-58.0F, +-57.0F, +-56.0F, +-56.0F, +-55.0F, +-54.0F, +-53.0F, +-52.0F, +-52.0F, +-51.0F, +-50.0F, +-50.0F, +-48.0F, +-48.0F, +-47.0F, +-47.0F, +-45.0F, +-45.0F, +-44.0F, +-44.0F, +-42.0F, +-42.0F, +-41.0F, +-41.0F, +-39.0F, +-39.0F, +-38.0F, +-38.0F, +-36.0F, +-36.0F, +-35.0F, +-35.0F, +-33.0F, +-33.0F, +-33.0F, +-31.0F, +-31.0F, +-30.0F, +-29.0F, +-29.0F, +-28.0F, +-27.0F, +-26.0F, +-26.0F, +-25.0F, +-24.0F, +-24.0F, +-23.0F, +-22.0F, +-21.0F, +-21.0F, +-20.0F, +-19.0F, +-19.0F, +-18.0F, +-17.0F, +-17.0F, +-16.0F, +-15.0F, +-15.0F, +-14.0F, +-13.0F, +-13.0F, +-12.0F, +-11.0F, +-11.0F, +-10.0F, +-9.0F, +-9.0F, +-8.0F, +-7.0F, +-7.0F, +-6.0F, +-6.0F, +-5.0F, +-4.0F, +-3.0F, +-4.0F, +-2.0F, +-2.0F, +-1.0F, +-1.0F, +0.0F, +1.0F, +1.0F, +2.0F, +2.0F, +3.0F, +3.0F, +4.0F, +5.0F, +5.0F, +6.0F, +6.0F, +7.0F, +7.0F, +8.0F, +8.0F, +9.0F, +10.0F, +10.0F, +10.0F, +11.0F, +12.0F, +12.0F, +13.0F, +13.0F, +13.0F, +14.0F, +15.0F, +15.0F, +15.0F, +16.0F, +16.0F, +17.0F, +17.0F, +18.0F, +18.0F, +19.0F, +19.0F, +20.0F, +20.0F, +20.0F, +21.0F, +21.0F, +22.0F, +22.0F, +22.0F, +23.0F, +23.0F, +24.0F, +24.0F, +24.0F, +25.0F, +25.0F, +25.0F, +26.0F, +26.0F, +27.0F, +26.0F, +28.0F, +27.0F, +28.0F, +28.0F, +29.0F, +28.0F, +30.0F, +29.0F, +30.0F, +30.0F, +30.0F, +31.0F, +30.0F, +32.0F, +31.0F, +32.0F, +32.0F, +32.0F, +32.0F, +33.0F, +33.0F, +33.0F, +33.0F, +34.0F, +34.0F, +34.0F, +34.0F, +35.0F, +34.0F, +35.0F, +35.0F, +35.0F, +36.0F, +36.0F, +35.0F, +36.0F, +36.0F, +37.0F, +36.0F, +37.0F, +36.0F, +37.0F, +37.0F, +38.0F, +37.0F, +37.0F, +38.0F, +37.0F, +38.0F, +38.0F, +38.0F, +38.0F, +38.0F, +38.0F, +39.0F, +38.0F, +38.0F, +39.0F, +39.0F, +38.0F, +39.0F, +39.0F, +38.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +39.0F, +38.0F, +39.0F, +39.0F, +38.0F, +39.0F, +38.0F, +39.0F, +38.0F, +38.0F, +38.0F, +38.0F, +38.0F, +38.0F, +38.0F, +38.0F, +37.0F, +38.0F, +37.0F, +38.0F, +37.0F, +37.0F, +37.0F, +37.0F, +36.0F, +37.0F, +36.0F, +37.0F, +36.0F, +36.0F, +36.0F, +36.0F, +35.0F, +36.0F, +35.0F, +35.0F, +35.0F, +35.0F, +34.0F, +35.0F, +34.0F, +34.0F, +34.0F, +34.0F, +33.0F, +34.0F, +33.0F, +33.0F, +33.0F, +33.0F, +31.0F, +32.0F, +32.0F, +32.0F, +32.0F, +31.0F, +31.0F, +31.0F, +31.0F, +31.0F, +30.0F, +30.0F, +30.0F, +30.0F, +29.0F, +30.0F, +29.0F, +28.0F, +29.0F, +28.0F, +28.0F, +28.0F, +28.0F, +27.0F, +27.0F, +27.0F, +27.0F, +26.0F, +27.0F, +26.0F, +25.0F, +26.0F, +25.0F, +25.0F, +24.0F, +25.0F, +24.0F, +24.0F, +23.0F, +24.0F, +23.0F, +23.0F, +22.0F, +23.0F, +22.0F, +22.0F, +21.0F, +22.0F, +21.0F, +20.0F, +21.0F, +20.0F, +20.0F, +20.0F, +19.0F, +19.0F, +19.0F, +19.0F, +18.0F, +18.0F, +18.0F, +17.0F, +17.0F, +17.0F, +17.0F, +17.0F, +16.0F, +16.0F, +15.0F, +15.0F, +16.0F, +14.0F, +15.0F, +14.0F, +14.0F, +14.0F, +13.0F, +13.0F, +13.0F, +13.0F, +12.0F, +12.0F, +12.0F, +11.0F, +12.0F, +11.0F, +10.0F, +11.0F, +10.0F, +10.0F, +10.0F, +9.0F, +9.0F, +9.0F, +8.0F, +9.0F, +8.0F, +8.0F, +7.0F, +7.0F, +7.0F, +7.0F, +7.0F, +6.0F, +6.0F, +6.0F, +5.0F, +5.0F, +5.0F, +5.0F, +4.0F, +5.0F, +3.0F, +4.0F, +4.0F, +3.0F, +3.0F, +3.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +1.0F, +1.0F, +1.0F, +0.0F, +1.0F, +0.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-2.0F, +-2.0F, +-2.0F, +-2.0F, +-3.0F, +-2.0F, +-3.0F, +-3.0F, +-4.0F, +-3.0F, +-4.0F, +-4.0F, +-4.0F, +-4.0F, +-5.0F, +-5.0F, +-5.0F, +-5.0F, +-5.0F, +-5.0F, +-6.0F, +-6.0F, +-6.0F, +-6.0F, +-6.0F, +-7.0F, +-7.0F, +-6.0F, +-8.0F, +-7.0F, +-7.0F, +-8.0F, +-7.0F, +-8.0F, +-8.0F, +-8.0F, +-9.0F, +-8.0F, +-9.0F, +-9.0F, +-9.0F, +-9.0F, +-9.0F, +-9.0F, +-10.0F, +-10.0F, +-9.0F, +-10.0F, +-10.0F, +-10.0F, +-11.0F, +-10.0F, +-11.0F, +-10.0F, +-11.0F, +-11.0F, +-11.0F, +-11.0F, +-12.0F, +-11.0F, +-11.0F, +-12.0F, +-12.0F, +-11.0F, +-12.0F, +-12.0F, +-12.0F, +-13.0F, +-12.0F, +-12.0F, +-13.0F, +-12.0F, +-13.0F, +-12.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-14.0F, +-13.0F, +-13.0F, +-14.0F, +-13.0F, +-14.0F, +-13.0F, +-14.0F, +-14.0F, +-13.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-15.0F, +-14.0F, +-15.0F, +-14.0F, +-15.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-15.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-15.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-13.0F, +-14.0F, +-14.0F, +-14.0F, +-14.0F, +-13.0F, +-14.0F, +-13.0F, +-14.0F, +-13.0F, +-14.0F, +-13.0F, +-13.0F, +-14.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-13.0F, +-12.0F, +-13.0F, +-12.0F, +-13.0F, +-12.0F, +-13.0F, +-12.0F, +-12.0F, +-12.0F, +-12.0F, +-12.0F, +-12.0F, +-12.0F, +-12.0F, +-11.0F, +-12.0F, +-12.0F, +-11.0F, +-10.0F, +-12.0F, +-11.0F, +-11.0F, +-11.0F, +-11.0F, +-11.0F, +-10.0F, +-11.0F, +-11.0F, +-10.0F, +-11.0F, +-10.0F, +-10.0F, +-10.0F, +-10.0F, +-10.0F, +-10.0F, +-10.0F, +-9.0F, +-10.0F, +-9.0F, +-10.0F, +-9.0F, +-9.0F, +-9.0F, +-9.0F, +-9.0F, +-9.0F, +-9.0F, +-8.0F, +-9.0F, +-8.0F, +-9.0F, +-8.0F, +-8.0F, +-8.0F, +-8.0F, +-8.0F, +-7.0F, +-8.0F, +-7.0F, +-8.0F, +-7.0F, +-7.0F, +-7.0F, +-7.0F, +-7.0F, +-7.0F, +-7.0F, +-6.0F, +-7.0F, +-6.0F, +-6.0F, +-7.0F, +-6.0F, +-6.0F, +-6.0F, +-5.0F, +-6.0F, +-6.0F, +-5.0F, +-5.0F, +-6.0F, +-5.0F, +-5.0F, +-5.0F, +-5.0F, +-4.0F, +-5.0F, +-5.0F, +-4.0F, +-4.0F, +-5.0F, +-4.0F, +-4.0F, +-4.0F, +-4.0F, +-4.0F, +-3.0F, +-4.0F, +-3.0F, +-4.0F, +-3.0F, +-3.0F, +-3.0F, +-3.0F, +-3.0F, +-3.0F, +-2.0F, +-3.0F, +-3.0F, +-2.0F, +-2.0F, +-3.0F, +-2.0F, +-2.0F, +-2.0F, +-1.0F, +-2.0F, +-2.0F, +-2.0F, +-1.0F, +-1.0F, +-2.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +1.0F, +0.0F, +1.0F, +0.0F, +1.0F, +0.0F, +1.0F, +1.0F, +1.0F, +1.0F, +1.0F, +1.0F, +1.0F, +2.0F, +1.0F, +1.0F, +2.0F, +1.0F, +2.0F, +2.0F, +2.0F, +1.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +3.0F, +2.0F, +2.0F, +3.0F, +2.0F, +3.0F, +2.0F, +3.0F, +2.0F, +3.0F, +3.0F, +3.0F, +2.0F, +3.0F, +3.0F, +3.0F, +3.0F, +3.0F, +4.0F, +3.0F, +3.0F, +3.0F, +4.0F, +3.0F, +3.0F, +4.0F, +3.0F, +4.0F, +3.0F, +4.0F, +3.0F, +4.0F, +4.0F, +3.0F, +4.0F, +4.0F, +4.0F, +4.0F, +3.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +4.0F, +5.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +4.0F, +3.0F, +4.0F, +4.0F, +4.0F, +3.0F, +4.0F, +4.0F, +3.0F, +4.0F, +3.0F, +4.0F, +4.0F, +3.0F, +4.0F, +3.0F, +3.0F, +4.0F, +3.0F, +3.0F, +4.0F, +3.0F, +3.0F, +4.0F, +3.0F, +3.0F, +3.0F, +3.0F, +3.0F, +3.0F, +3.0F, +3.0F, +3.0F, +3.0F, +2.0F, +3.0F, +3.0F, +2.0F, +3.0F, +3.0F, +3.0F, +2.0F, +3.0F, +3.0F, +2.0F, +3.0F, +2.0F, +3.0F, +2.0F, +3.0F, +2.0F, +2.0F, +3.0F, +2.0F, +2.0F, +3.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +2.0F, +1.0F, +2.0F, +2.0F, +2.0F, +1.0F, +2.0F, +1.0F, +2.0F, +1.0F, +2.0F, +1.0F, +2.0F, +1.0F, +2.0F, +1.0F, +1.0F, +1.0F, +2.0F, +1.0F, +1.0F, +1.0F, +1.0F, +1.0F, +2.0F, +1.0F, +1.0F, +1.0F, +1.0F, +0.0F, +1.0F, +1.0F, +1.0F, +1.0F, +1.0F, +0.0F, +1.0F, +1.0F, +1.0F, +0.0F, +1.0F, +0.0F, +1.0F, +1.0F, +0.0F, +1.0F, +0.0F, +1.0F, +0.0F, +0.0F, +1.0F, +0.0F, +0.0F, +1.0F, +0.0F, +0.0F, +0.0F, +1.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +1.0F, +-1.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +0.0F, +-1.0F, +0.0F, +0.0F, +0.0F, +0.0F, +-1.0F, +0.0F, +0.0F, +-1.0F, +0.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +0.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +-1.0F, +0.0F, +-1.0F, +-1.0F, +0.0F, +-28.0F}; diff --git a/nyqsrc/handlers.c b/nyqsrc/handlers.c new file mode 100644 index 0000000..a57691c --- /dev/null +++ b/nyqsrc/handlers.c @@ -0,0 +1,120 @@ +/* handlers.c -- null handlers to avoid link errors due to callouts in moxc.c */ + +#include "musiprog.h" + +char *app_syntax = ""; + +/* note -- a simple way to make a midi note on channel 1 */ +/**/ +void note(pitch, dur) +{ +} + +/* asciievent -- ascii event handler */ +/**/ +void asciievent(char c) +{ +} + + +/* keyup -- key up handler */ +/**/ +void keyup(int c, int k) +{ + /* insert key up actions here */ +} + + +/* keydown -- key down handler */ +/**/ +void keydown(int c, int k, int v) +{ + /* insert key down actions here */ +} + + +/* midievent -- handle a midi message */ +/**/ +void midievent(midi_data) + byte midi_data[4]; +{ + /* this is only called if mididecode is false so */ + /* you can assume this function is never called */ +} + + +/* prgmchange -- program change handler */ +/**/ +void prgmchange(int chan, int value) +{ + /* insert program change actions here */ +} + + +/* bendchange -- pitch bend handler */ +/**/ +void bendchange(int chan, int value) +{ + /* insert pitchbend actions here */ +} + + +/* ctrlchange -- control change handler */ +/**/ +void ctrlchange(int chan, int ctrl, int value) +{ + /* insert control change actions here */ +} + + +/* peddown -- pedal down handler */ +/**/ +void peddown(int c) +{ + /* insert pedal down actions here */ + /* the following default action invokes your control change handler */ + ctrlchange(c, SUSTAIN, 127); +} + + +/* pedup -- pedal up handler */ +/**/ +void pedup(int c) +{ + /* insert pedal up actions here */ + /* the following default action invokes your control change handler */ + ctrlchange(c, SUSTAIN, 0); +} + + +/* touchchange -- after touch handler */ +/**/ +void touchchange(int chan, int value) +{ + /* insert after touch actions here */ +} + + +void sysex(void) +{ +} + + +/* + * NOTE: this is called just before closing down the midi interface. + */ +void coda(void) +{ +} + + +#ifdef AMIGA +void buttonchange(int number, int value) +{ +} + +void propchange(int number, int value) +{ + /* insert propchange actions here */ +} +#endif diff --git a/nyqsrc/inverse.c b/nyqsrc/inverse.c new file mode 100644 index 0000000..1dd757c --- /dev/null +++ b/nyqsrc/inverse.c @@ -0,0 +1,214 @@ +/* inverse.c -- compute the inverse of a sampled function */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "cext.h" + +#include "falloc.h" +#include "inverse.h" + +void inverse_free(); + + +typedef struct inverse_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + double s_prev; + double s_time; + double s_time_increment; + double out_time_increment; + boolean started; +} inverse_susp_node, *inverse_susp_type; + +void inverse_fetch(register inverse_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples read from s */ + int out_cnt = 0; /* how many samples output */ + int togo = 0; /* how many more to read from s in inner loop */ + int n; + sample_block_type out; + double out_time = susp->susp.current * susp->out_time_increment; + + register sample_block_values_type out_ptr; + + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "inverse_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure we are primed with first value */ + /* This is a lot of work just to prefetch susp->s_prev! */ + if (!susp->started) { + susp->started = true; + /* see comments below about susp_check_term_log_samples() */ + if (susp->s_cnt == 0) { + susp_get_samples(s, s_ptr, s_cnt); + if (susp->s_ptr == zero_block->samples) { + susp->terminate_cnt = susp->susp.current; + } + } + susp->s_prev = susp_fetch_sample(s, s_ptr, s_cnt); + } + + while (out_cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't run past the s input sample block: */ + /* most fetch routines call susp_check_term_log_samples() here + * but we can't becasue susp_check_term_log_samples() assumes + * that output time progresses at the same rate as input time. + * Here, some time warping is going on, so this doesn't work. + * Instead, check for termination of s and fix terminate_cnt to + * be the current output count rather than the current input time. + */ + if (susp->s_cnt == 0) { + susp_get_samples(s, s_ptr, s_cnt); + if (susp->s_ptr == zero_block->samples) { + susp->terminate_cnt = susp->susp.current + out_cnt; + /* we can't simply terminate here because we might have + * some output samples computed already, in which case we + * want to return them now and terminate the NEXT time we're + * called. + */ + } + } + togo = susp->s_cnt; + + /* if we ran past terminate time, fix up output */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + out_cnt) { + /* pretend like we computed the correct number of samples */ + togo = 0; + out_cnt = susp->terminate_cnt - susp->susp.current; + /* exit the loop to complete the termination */ + break; + } + n = togo; + s_ptr_reg = susp->s_ptr; + if (n) do { /* the inner sample computation loop */ + /* scan s_ptr_reg to time t, output and loop */ + register double next_value = *s_ptr_reg++; + while (out_time < next_value) { + *out_ptr++ = (float) (susp->s_time + + (out_time - susp->s_prev) / + (susp->s->sr * (next_value - susp->s_prev))); + out_time += susp->out_time_increment; + if (++out_cnt >= max_sample_block_len) goto output_full; + } + susp->s_prev = next_value; + susp->s_time += susp->s_time_increment; + } while (--n); /* inner loop */ + output_full: + /* using s_ptr_reg is a bad idea on RS/6000: */ + susp->s_ptr += (togo - n); + susp_took(s_cnt, (togo - n)); + cnt += (togo - n); + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && out_cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = out_cnt; + susp->susp.current += out_cnt; + } +} /* inverse_fetch */ + + +void inverse_toss_fetch(susp, snd_list) + register inverse_susp_type susp; + snd_list_type snd_list; +{ + long final_count = MIN(susp->susp.current + max_sample_block_len, + susp->susp.toss_cnt); + time_type final_time = susp->susp.t0 + final_count / susp->susp.sr; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while (((long) ((final_time - susp->s->t0) * susp->s->sr + 0.5)) >= + susp->s->current) + susp_get_samples(s, s_ptr, s_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + if (final_count == susp->susp.toss_cnt) { + n = ROUND((final_time - susp->s->t0) * susp->s->sr - + (susp->s->current - susp->s_cnt)); + susp->s_ptr += n; + susp_took(s_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + } + snd_list->block_len = (short) (final_count - susp->susp.current); + susp->susp.current = final_count; + snd_list->u.next = snd_list_create((snd_susp_type) susp); + snd_list->block = internal_zero_block; +} + + +void inverse_mark(inverse_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void inverse_free(inverse_susp_type susp) +{ + sound_unref(susp->s); + ffree_generic(susp, sizeof(inverse_susp_node), "inverse_free"); +} + + +void inverse_print_tree(inverse_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_inverse(sound_type s, time_type t0, rate_type sr) +{ + register inverse_susp_type susp; + + falloc_generic(susp, inverse_susp_node, "snd_make_inverse"); + susp->susp.fetch = inverse_fetch; + susp->terminate_cnt = UNKNOWN; + + /* initialize susp state */ + susp->susp.free = inverse_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = inverse_mark; + susp->susp.print_tree = inverse_print_tree; + susp->susp.name = "inverse"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = UNKNOWN; /* log stop time = term time */ + susp->susp.current = 0; + susp->s = s; + susp->s_cnt = 0; + susp->s_prev = 0; + susp->s_time = 0; + susp->s_time_increment = 1 / s->sr; + susp->out_time_increment = 1 / (sr * s->scale); + susp->started = false; + return sound_create((snd_susp_type)susp, t0, sr, 1.0 /* scale */); +} + + +sound_type snd_inverse(sound_type s, time_type t0, rate_type sr) +{ + sound_type s_copy = sound_copy(s); + return snd_make_inverse(s_copy, t0, sr); +} diff --git a/nyqsrc/inverse.h b/nyqsrc/inverse.h new file mode 100644 index 0000000..4ecf563 --- /dev/null +++ b/nyqsrc/inverse.h @@ -0,0 +1,3 @@ +sound_type snd_make_inverse(sound_type s, time_type t0, rate_type sr); +sound_type snd_inverse(sound_type s, time_type t0, rate_type sr); + /* LISP: (snd-inverse SOUND ANYNUM ANYNUM) */ diff --git a/nyqsrc/local.c b/nyqsrc/local.c new file mode 100644 index 0000000..1cd3eed --- /dev/null +++ b/nyqsrc/local.c @@ -0,0 +1,55 @@ +/* local.c -- call initialization code for all extensions */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +#include "xlisp.h" +#include "sound.h" +#include "samples.h" +#ifdef CMTSTUFF +#include "seqext.h" +#endif +#include "falloc.h" +#include "sine.h" +#include "stkinit.h" + +LVAL RSLT_sym; + +void localinit(void) +{ + falloc_init(); +/* probe_init(true);*/ + sound_init(); +#ifdef CMTSTUFF + seqext_init(); +#endif + sine_init(); + stk_init(); +} + + +void localsymbols(void) +{ + RSLT_sym = xlenter("*RSLT*"); + sound_symbols(); + samples_symbols(); +#ifdef CMTSTUFF + seqext_symbols(); +#endif +} + +extern int sample_block_total; +extern int sample_block_used; + +void print_local_gc_info(void) +{ + char buf[50]; + /* print sample blocks */ + sprintf(buf, "; samples %dKB, %dKB free", + (sample_block_total * max_sample_block_len) / 1024, + ((sample_block_total - sample_block_used) * + max_sample_block_len) / 1024); + stdputstr(buf); +} diff --git a/nyqsrc/localdefs.h b/nyqsrc/localdefs.h new file mode 100644 index 0000000..b227c2f --- /dev/null +++ b/nyqsrc/localdefs.h @@ -0,0 +1,3 @@ +/* include actual local file headers: */ +#include "sndfnintdefs.h" +#include "seqfnintdefs.h" diff --git a/nyqsrc/localptrs.h b/nyqsrc/localptrs.h new file mode 100644 index 0000000..8789cfa --- /dev/null +++ b/nyqsrc/localptrs.h @@ -0,0 +1,9 @@ +/* localptrs.h -- extend XLISP with these functions + * + * CHANGE LOG + * 28-Apr-03 rbd Removed "include switches.h" -- already included + */ + +/* extension to xlisp */ +#include "sndfnintptrs.h" +#include "seqfnintptrs.h" diff --git a/nyqsrc/lpanal.c b/nyqsrc/lpanal.c new file mode 100644 index 0000000..d6baf98 --- /dev/null +++ b/nyqsrc/lpanal.c @@ -0,0 +1,177 @@ +/* lpc.c -- implement LPC analysis */ + +#include <math.h> + +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" + + +void abs_max(double *x, long desde, long hasta, double *x_maxptr, long *indptr) +{ + /* use: + abs_max(s,0,10,&mimax,&miind); + */ + + double x_max = x[desde]; + long ind = desde; + long i; + for(i = desde+1; i<hasta; i++) + if (fabs(x[i]) > x_max) + { + x_max = fabs(x[i]); + ind = i; + } + *x_maxptr = x_max; + *indptr = ind; + +} + +void xcorr(double *s, double *rxx, long N) +{ + /* use: + xcorr(s,rxx,N); + */ + long i,j; + for(i=0; i < N; i++) + { + rxx[i] = 0.0; + for(j=0; j < N-i; j++) + rxx[i] += s[j]*s[j+i]; + } +} + + + + +// SOUND PARAMETERS +// w Lisp vector containinig signal values +// P number of poles +// N length of sound + +// AUTOCORRELEATION PARAMETERS +// rxx array containing autocorrelation coefs +// max_rxx temporal maximun value of rxx +// i_max index of max_rxx + +// LPC PARAMETERS +// alpha array of filter coefs +// k reflection coef +// E residual energy +// rms1 energy of input signal (not RMS) +// rms2 residual energy = E +// unv voiced/unvoiced parameter = ERR = rms2/rms1 + +// PITCH DETECTION ALGORITHM: Implemented separately + + + +LVAL snd_lpanal(LVAL w, long P) +{ + + double *s, *rxx; + long N; + double *alpha; + // double *k, *E; THIS ONLY FOR VECTORIZED k AND E + double k, E; + double rms1; // rms2=E; + double unv; + double suma, alphatemp; // help variables + + + long i,j; + LVAL result; + + xlsave1(result); + + + + //// end vars ///////////// + + + + //// allocate memory /////// + N = getsize(w); + s = calloc(sizeof(double),N); //signal + rxx = calloc(sizeof(double),N); //autocorrelation + alpha = calloc(sizeof(double), P); // filter coefs + //k = calloc(sizeof(double), P); // reflection coefs + //E = calloc(sizeof(double), P); // residual energy + + + ////// copy Lisp array sound data to array of double /////// + for(i=0; i<N; i++) + s[i] = getflonum(getelement(w,i)); + + ///// autocorrelation //////////////// + + xcorr(s,rxx,N); // this may be optimized as only P autocorr factors are needed (not N) + + + //////// LPC analysis ////////////////////////////////// + + /// Durbin algorithm + + /// inicialization + //for(i=0; i<P;i++) + // alpha[i]=k[i]=E[i]=0.0; // don't need this. Done by default. + + //E[0] = rxx[0] - pow(rxx[1],2)/rxx[0]; + //k[0] = rxx[1]/rxx[0]; + //alpha[0] = k[0]; + E = rxx[0] - pow(rxx[1],2)/rxx[0]; // NO VECTORS k OR E + k = rxx[1]/rxx[0]; // + alpha[0] = k; // + + /// recursive solve + for(i=1;i<P;i++) + { + suma=0.0; + for(j=0;j<i;j++) + suma += alpha[j] * rxx[i-j]; + //k[i] = (rxx[i+1]-suma)/E[i-1]; + //alpha[i]=k[i]; + k = (rxx[i+1]-suma)/E; + alpha[i]=k; + for(j=0; j <= ((i-1) >> 1); j++) + { + //alphatemp = alpha[j] - k[i] * alpha[i-j-1]; + //alpha[i-j-1] -= k[i] * alpha[j]; + //alpha[j] = alphatemp; + alphatemp = alpha[j] - k * alpha[i-j-1]; + alpha[i-j-1] -= k * alpha[j]; + alpha[j] = alphatemp; + + } + //E[i] = E[i-1] * (1 - pow(k[i],2)); + E *= (1 - pow(k,2)); + + } + + // input signal energy = rxx[0]; + rms1 = rxx[0]; + + // voiced/unvoiced + unv= sqrt(E/rms1); + + ///// HERE: CHECK STABILITY AND MODIFY COEFS ///////////// + ///// not implemented + + + + // prepare output result + result = newvector(P); + for (i = 0; i < P; i++) setelement(result, i, cvflonum(alpha[P-i-1])); // alpoles format + + xlpop(); + + // free memory + free(s); free(rxx); free(alpha); + + return (cons (cvflonum(rms1), // input signal energy + cons(cvflonum(E), // residual energy + cons(cvflonum(unv), // ERR, voiced/unvoiced + cons(result, NULL))))); // coefs + +} diff --git a/nyqsrc/lpanal.h b/nyqsrc/lpanal.h new file mode 100644 index 0000000..87af9c0 --- /dev/null +++ b/nyqsrc/lpanal.h @@ -0,0 +1,4 @@ +/* lpanal.h -- LPC analysis */ + +LVAL snd_lpanal(LVAL v, long P); + /* LISP: (SND-LPANAL ANY FIXNUM) */ diff --git a/nyqsrc/multiread.c b/nyqsrc/multiread.c new file mode 100644 index 0000000..9c34be3 --- /dev/null +++ b/nyqsrc/multiread.c @@ -0,0 +1,298 @@ +/* multiread.c -- read multichannel sound file */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +#include "stdio.h" +#ifdef UNIX +#include "sys/file.h" +#endif +#ifndef mips +#include "stdlib.h" +#endif +#include "sndfmt.h" +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "sndfile.h" +#include "sndread.h" +#include "multiread.h" + +/* allocate input buffer space for this many bytes/frame, + * e.g. 8 allows 2 channels + * If frames are bigger, then multiple reads will be issued. + */ +#define max_bytes_per_frame (sizeof(float) * 2) +#define input_buffer_max (max_sample_block_len * max_bytes_per_frame) +#define input_buffer_samps (max_sample_block_len * 2) + + +/* multiread_fetch - read samples into multiple channels. */ +/* + * The susp is shared by all channels. The susp has backpointers + * to the tail-most snd_list node of each channels, and it is by + * extending the list at these nodes that sounds are read in. + * To avoid a circularity, the reference counts on snd_list nodes + * do not include the backpointers from this susp. When a snd_list + * node refcount goes to zero, the multiread susp's free routine + * is called. This must scan the backpointers to find the node that + * has a zero refcount (the free routine is called before the node + * is deallocated, so this is safe). The backpointer is then set + * to NULL. When all backpointers are NULL, the susp itself is + * deallocated, because it can only be referenced through the + * snd_list nodes to which there are backpointers. + */ +void multiread_fetch(susp, snd_list) + register read_susp_type susp; + snd_list_type snd_list; +{ + int i, j; + int frames_read = 0; /* total frames read in this call to fetch */ + int n; + sample_block_type out; + // char input_buffer[input_buffer_max]; + float input_buffer[input_buffer_samps]; + int file_frame_size; + + /* when we are called, the caller (SND_get_first) will insert a new + * snd_list node. We need to do this here for all other channels. + */ + for (j = 0; j < susp->sf_info.channels; j++) { + +/* nyquist_printf("multiread_fetch: chan[%d] = ", j); + print_snd_list_type(susp->chan[j]); + stdputstr("\n"); + */ + if (!susp->chan[j]) { /* ignore non-existent channels */ +/* nyquist_printf("multiread_fetch: ignore channel %d\n", j);*/ + continue; + } + falloc_sample_block(out, "multiread_fetch"); +/* nyquist_printf("multiread: allocated block %x\n", out); */ + /* Since susp->chan[i] exists, we want to append a block of samples. + * The block, out, has been allocated. Before we insert the block, + * we must figure out whether to insert a new snd_list_type node for + * the block. Recall that before SND_get_next is called, the last + * snd_list_type in the list will have a null block pointer, and the + * snd_list_type's susp field points to the suspension (in this case, + * susp). When SND_get_next (in sound.c) is called, it appends a new + * snd_list_type and points the previous one to internal_zero_block + * before calling this fetch routine. On the other hand, since + * SND_get_next is only going to be called on one of the channels, the + * other channels will not have had a snd_list_type appended. + * SND_get_next does not tell us directly which channel it wants (it + * doesn't know), but we can test by looking for a non-null block in the + * snd_list_type pointed to by our back-pointers in susp->chan[]. If + * the block is null, the channel was untouched by SND_get_next, and + * we should append a snd_list_type. If it is non-null, then it + * points to internal_zero_block (the block inserted by SND_get_next) + * and a new snd_list_type has already been appended. + */ + /* Before proceeding, it may be that garbage collection ran when we + * allocated out, so check again to see if susp->chan[j] is Null: + */ + if (!susp->chan[j]) { + ffree_sample_block(out, "multiread_fetch"); + continue; + } + if (!susp->chan[j]->block) { + snd_list_type snd_list = snd_list_create((snd_susp_type) susp); + /* Now we have a snd_list to append to the channel, but a very + * interesting thing can happen here. snd_list_create, which + * we just called, MAY have invoked the garbage collector, and + * the GC MAY have freed all references to this channel, in which + * case multread_free(susp) will have been called, and susp->chan[j] + * will now be NULL! + */ + if (!susp->chan[j]) { + nyquist_printf("susp %p Channel %d disappeared!\n", susp, j); + ffree_snd_list(snd_list, "multiread_fetch"); + } else { + susp->chan[j]->u.next = snd_list; + } + } + /* see the note above: we don't know if susp->chan still exists */ + /* Note: We DO know that susp still exists because even if we lost + * some channels in a GC, someone is still calling SND_get_next on + * some channel. I suppose that there might be some very pathological + * code that could free a global reference to a sound that is in the + * midst of being computed, perhaps by doing something bizarre in the + * closure that snd_seq activates at the logical stop time of its first + * sound, but I haven't thought that one through. + */ + if (susp->chan[j]) { + susp->chan[j]->block = out; + /* check some assertions */ + if (susp->chan[j]->u.next->u.susp != (snd_susp_type) susp) { + nyquist_printf("didn't find susp at end of list for chan %d\n", j); + } + } else { /* we allocated out, but don't need it anymore due to GC */ + ffree_sample_block(out, "multiread_fetch"); + } + } + + file_frame_size = susp->sf_info.channels; + + /* now fill sample blocks with frames from the file + until eof or end of blocks */ + while (true) { + + /* compute how many frames to read to fill sample blocks */ + long frame_count = max_sample_block_len - frames_read; + long actual; /* how many frames actually read */ + + /* make sure frames will fit in buffer */ + if (frame_count * file_frame_size > input_buffer_samps) { + frame_count = input_buffer_samps / file_frame_size; + } + + actual = sf_readf_float(susp->sndfile, input_buffer, frame_count); + n = actual; + + /* don't read too many */ + if (n > (susp->cnt - susp->susp.current)) { + n = susp->cnt - susp->susp.current; + } + + /* process one channel at a time, multiple passes through input */ + for (j = 0; j < susp->sf_info.channels; j++) { + register sample_block_values_type out_ptr; + /* offset by channel number: */ + float *float_ptr = input_buffer + j; + + /* ignore nonexistent channels */ + if (!susp->chan[j]) continue; + + /* find pointer to sample buffer */ + out_ptr = susp->chan[j]->block->samples + frames_read; + + /* copy samples */ + for (i = 0; i < n; i++) { + *out_ptr++ = *float_ptr; + float_ptr += susp->sf_info.channels; + } + susp->chan[j]->block_len = frames_read + n; + } + + /* jlh BECAUSE, at this point, all the code cares about is + that n frames have been read and the samples put into their + appropriate snd_node buffers. */ + + frames_read += n; + susp->susp.current += n; + + if (frames_read == 0) { + /* NOTE: this code should probably be removed -- how could we + ever get here? Since file formats know the sample count, we'll + always read frames. When we hit the end-of-file, the else + clause below will run and terminate the sound, so we'll never + try and read samples that are not there. The only exception is + an empty sound file with no samples, in which case we could omit + this if test and execute the else part below. + + This code *might* be good for formats that do not encode a + sample count and where reading the end of file is the only way + to detect the end of the data. + + Since it seeems to work, I'm going to leave this in place. + One tricky point of the algorithm: when we get here, we set up + susp->chan[j] to point to the right place and then call + snd_list_terminate(). This deletes the snd_list that chan[j] + is pointing to, but not before calling multiread_free(), which + upon detecting that the sound is being freed, sets chan[j] to + NULL. This works sequentially on each channel and than last + time, this susp is freed because no channels are active. + */ + /* we didn't read anything, but can't return length zero, so + * convert snd_list's to pointer to zero block. This loop + * will free the susp via snd_list_unref(). + */ + for (j = 0; j < susp->sf_info.channels; j++) { + if (susp->chan[j]) { + snd_list_type the_snd_list = susp->chan[j]; + /* this is done so that multiread_free works right: */ + susp->chan[j] = susp->chan[j]->u.next; + /* nyquist_printf("end of file, terminating channel %d\n", j); */ + /* this fixes up the tail of channel j */ + snd_list_terminate(the_snd_list); + } + } + return; + } else if (susp->cnt == susp->susp.current || actual < frame_count) { + /* we've read the requested number of frames or we + * reached end of file + * last iteration will close file and free susp: + */ + for (j = 0; j < susp->sf_info.channels; j++) { + snd_list_type the_snd_list = susp->chan[j]; + /* nyquist_printf("reached susp->cnt, terminating chan %d\n", j); */ + if (the_snd_list) { + /* assert: */ + if (the_snd_list->u.next->u.susp != (snd_susp_type) susp) { + stdputstr("assertion violation"); + } + /* this is done so that multiread_free works right: */ + susp->chan[j] = the_snd_list->u.next; + snd_list_unref(the_snd_list->u.next); + /* terminate by pointing to zero block */ + the_snd_list->u.next = zero_snd_list; + } + } + return; + } else if (frames_read >= max_sample_block_len) { + /* move pointer to next list node */ + for (j = 0; j < susp->sf_info.channels; j++) { + if (susp->chan[j]) susp->chan[j] = susp->chan[j]->u.next; + } + return; + } + } +} /* multiread__fetch */ + + +void multiread_free(read_susp_type susp) +{ + int j; + boolean active = false; +/* stdputstr("multiread_free: "); */ + for (j = 0; j < susp->sf_info.channels; j++) { + if (susp->chan[j]) { + if (susp->chan[j]->refcnt) active = true; + else { + susp->chan[j] = NULL; + /* nyquist_printf("deactivating channel %d\n", j); */ + } + } + } + if (!active) { + /* stdputstr("all channels freed, freeing susp now\n"); */ + read_free(susp); + } +} + + +LVAL multiread_create(susp) + read_susp_type susp; +{ + LVAL result; + int j; + + xlsave1(result); + + result = newvector(susp->sf_info.channels); /* create array for sounds */ + falloc_generic_n(susp->chan, snd_list_type, susp->sf_info.channels, + "multiread_create"); + /* create sounds to return */ + for (j = 0; j < susp->sf_info.channels; j++) { + sound_type snd = sound_create((snd_susp_type)susp, + susp->susp.t0, susp->susp.sr, 1.0); + LVAL snd_lval = cvsound(snd); +/* nyquist_printf("multiread_create: sound %d is %x, LVAL %x\n", j, snd, snd_lval); */ + setelement(result, j, snd_lval); + susp->chan[j] = snd->list; + } + xlpop(); + return result; +} diff --git a/nyqsrc/multiread.h b/nyqsrc/multiread.h new file mode 100644 index 0000000..7bd1b17 --- /dev/null +++ b/nyqsrc/multiread.h @@ -0,0 +1,3 @@ +LVAL multiread_create(read_susp_type susp); +void multiread_fetch(read_susp_type susp, snd_list_type snd_list); +void multiread_free(read_susp_type susp); diff --git a/nyqsrc/multiseq.c b/nyqsrc/multiseq.c new file mode 100644 index 0000000..367b5f6 --- /dev/null +++ b/nyqsrc/multiseq.c @@ -0,0 +1,673 @@ +/* multiseq.c -- return a multichannel signal until its logical stop, then + evaluate a closure to get another signal and convert to adds + of two multichannel signals */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "multiseq.h" +#include "add.h" +#include "scale.h" +#include "extern.h" +#include "cext.h" + +/* #define MULTISEQ_GC_DEBUG */ +#ifdef MULTISEQ_GC_DEBUG +extern snd_list_type snd_list_to_watch; +#endif + +/* #define GC_DEBUG */ +#ifdef GC_DEBUG +extern sound_type sound_to_watch; +#endif + + +#define D if(0) + +/* Design: + +This operator implements sequences of multichannel signals. +A single data structure manages an array of susps that +initially are used to fetch blocks from the first multichannel +signal. When the LAST logical stop is reached, a closure +is evaluated to yield a new multichannel signal. The component +sounds of this are stored into the susps which are then +converted into add suspensions. The other managing structures +are then freed. + +The main constraint here is that the conversion to add susps +must take place at the same time across all channels, so before +the conversion, a fetch from the susp can only be made if it is +known that the samples returned happen BEFORE the conversion will +take place. Since the conversion takes place at the maximum of +the logical stop times of all channels, we have to advance all +channels synchronously. We keep track of a greatest lower bound, +refered to as the horizon, on the maximum logical stop time. It +is safe to fetch blocks up to the horizon, but not beyond. + +This synchronous fetching is done by a single routine and an +auxilliarly structure that manages the whole multichannel array +of susps. The basic idea is that a fetch from a +suspension gets forwarded to the managing structure, which +uses its array of susps to fetch from ALL suspensions up to +the requested time or until the logical stop, whichever comes +first. These "synchronous" fetches are not made by calling the +fetch routines on the suspensions to avoid infinite recursion. + +At any time, there will be some set of channels whose logical +stop time is unknown. The "s1" fields (s1, s1_ptr, s1_bptr) of +these suspensions are used to look ahead by geting a block from +s1. If no logical stop is indicated, then we can append the block +to the snd_list and update the horizon, allowing fetches from other +susps. In other words, the s1_bptr of each susp provides a one +buffer lookahead by which we can obtain advance knowledge of the +maximum logical stop time. + +The algorithm is as follows: + +1. When fetch is called on a suspension, compute when any +prefetched samples will end (if there are none, then fetch +a block from s1 and compute the time at which the block ends). +This becomes the target time for other fetches. + +2. Call multiseq_advance(), passing the target time and the +manager structure (which has pointers to all other channels). +(Note: every susp has a pointer to the manager). +The function of multiseq_advance() is to push the horizon for +the logical stop forward. This is done by +iterating over the array of susps until the target is reached. +Actually, the array contains pointers to the snd_list_node that +points to each susp and where the next block will be linked. +The goal of this loop is to satisfy the original fetch, which +means we have to push low_water to greater than or equal to the +target. (Low water is the minimum time of the next sample to +be returned by any multiseq susp.) This goal will be met unless +we reach the last logical stop time, in which case we evaluate +the closure for the next multichannel sound, convert +everything to add's and let the additions take care of returning +blocks. + +3. The Iteration Loop: +low_water is the lowest sample count of the next sample +horizon is the greatest lower bound on the maximum logical stop time +Iterate over susps until low_water >= target +(Note: whenever data is fetched for a sound whose logical stop time +is unknown, update the horizon. If a logical stop time becomes known, +then test if the final maximum logical stop time is known (by keeping +a count of how many are still unknown), and if the count goes to zero, +evaluate the continuation and convert to multiple adds.) +(Another Note: we may reach the logical stop time and convert to +multiple adds before the loop terminates, in which case we return +without finishing the loop. Take care that the caller does the right +thing to produce a sample block in this case.) + +3a. If a block hasn't been prefetched, do it. + +3b. While the susp has prefetched a block that ends at or before horizon, +put the block on the snd_list and prefetch another block. + +3c. If the susp hasn't a known logical stop time, set new_horizon to +the end time of the last sample prefetched in 3b. + +3d. If new_horizon == horizon, signal an error, no progress was made. + +3d. Set horizon to new_horizon and repeat the loop. + +NOTE ON A BUG FIX (1 Jul 95): old code assumed that when a logical stop +was detected it was at the beginning of the next block, but if logical +stop is explicit, then it may be way in the future. We could convert +to adds at this point, but that would force early evaluation of the +closure, which we'd like to delay (be lazy when possible). Therefore, +we want to ignore knowledge of a logical stop time until the logical +stop time falls within the currently known block of samples. By "currently +known", I mean somewhere in the block referenced by ->s1_ptr and ->s1_cnt. + +*/ + +/* extern LVAL s_stdout; */ + +void multiseq_convert(multiseq_type ms); +void multiseq_free(add_susp_type susp); +sample_block_type multiseq_get_next(sound_type snd, long * cnt); +void multiseq_print_tree(add_susp_type susp, int n); + + +#define susp_cnt_time(ssp, ms, cnt) (ssp->susp.t0 - ms->t0 + (cnt)/ssp->s1->sr) +#define susp_time(ssp, ms) susp_cnt_time(ssp, ms, \ + (ssp->susp.current + ssp->s1_cnt)) +#define susp_low_water(ssp, ms) susp_cnt_time(ssp, ms, ssp->susp.current) +#define susp_log_stop_time(ssp, ms) susp_cnt_time(ssp, ms, ssp->susp.log_stop_cnt) + + +/* multiseq_advance fetches from each channel to advance to target time */ +/* + * If a channel terminates early, we must be careful: continuing to + * fetch will return pointers to the zero_block, but this will + * indicate termination to whoever is fetching from multiseq. We + * must check the pointers and substitute internal_zero_block to + * avoid premature termination. + */ +void multiseq_advance(multiseq_type ms, time_type target) +{ + int i; + time_type new_horizon; + time_type new_low_water; + +D nyquist_printf("multiseq_advance: %p->low_water %g, target %g\n", + ms, ms->low_water, target); + while (ms->low_water < target - 0.000001) { + new_horizon = 0.0; +D nyquist_printf("multiseq_advance loop: target %g low_water %g horizon %g\n", + target, ms->low_water, ms->horizon); + /* new_low_water will be a minimum over every + * channel, so start with a big number */ + new_low_water = target; + for (i = 0; i < ms->nchans; i++) { + snd_list_type snd_list = ms->chans[i]; + add_susp_type susp = (add_susp_type) snd_list->u.susp; + time_type my_hor; + time_type my_low_water; +D nyquist_printf("chans[%d]: ", i); + + /* fetch up to horizon */ + + /* see if susp has an unprocessed block (test on susp->s1_ptr + * is probably not necessary, in fact, it isn't initialized + * until the first block is fetched, but s1_cnt is + */ + if (susp->s1_cnt && susp->s1_ptr && + susp->s1_ptr == susp->s1_bptr->samples) { + /* do nothing, unprocessed block already there as a + * result of the initiating fetch + */ + } else if (susp->s1_cnt != 0) { + stdputstr("multiseq_advance: s1_cnt != 0\n"); + EXIT(1); /* this should never happen */ + } else { /* otherwise fetch it */ +D stdputstr("prefetching samples "); + susp_get_block_samples(s1, s1_bptr, s1_ptr, s1_cnt); + if (susp->s1_ptr == zero_block->samples) { + susp->terminate_bits = 1; + susp->s1_bptr = internal_zero_block; + susp->s1_ptr = internal_zero_block->samples; + } + /* see if we've reached a logical stop + * (I can't believe this code block is in 3 places - + * there must be a better way... RBD) + */ + if (!susp->logical_stop_bits) { + if (susp->s1->logical_stop_cnt != UNKNOWN) { + if (susp->susp.current + susp->s1_cnt >= + susp->s1->logical_stop_cnt) { + susp->logical_stop_bits = 1; + susp->susp.log_stop_cnt = + susp->s1->logical_stop_cnt; + ms->not_logically_stopped_cnt--; +D nyquist_printf( + "snd_make_multiseq: Logical stop reached, not_logically_stopped_cnt %d\n", + ms->not_logically_stopped_cnt); + } + } + } + } +D nyquist_printf(" current %d cnt %d ", + (int)susp->susp.current, (int)susp->s1_cnt); + + /* while the susp has prefetched a block that ends at or + * before horizon, put the block on the snd_list and + * prefetch another block + */ + while (susp_time(susp, ms) < ms->horizon + 0.000001) { + snd_list->block = susp->s1_bptr; + snd_list->block_len = (short) susp->s1_cnt; + susp->susp.current += susp->s1_cnt; + (susp->s1_bptr->refcnt)++; + susp->s1_cnt = 0; +#ifdef MULTISEQ_GC_DEBUG + nyquist_printf( + "multiseq: output block %p%s on snd_list %p to chan %d\n", + susp->s1_bptr, + (susp->s1_bptr == internal_zero_block ? + " (INTERNAL ZERO BLOCK)" : ""), + snd_list, i); +#endif + snd_list->u.next = snd_list_create(&(susp->susp)); +#ifdef MULTISEQ_GC_DEBUG + snd_list_debug(snd_list, "multiseq_advance"); +#endif + ms->chans[i] = snd_list = snd_list->u.next; + susp_get_block_samples(s1, s1_bptr, s1_ptr, s1_cnt); + if (susp->s1_ptr == zero_block->samples) { + susp->terminate_bits = 1; + susp->s1_bptr = internal_zero_block; + susp->s1_ptr = internal_zero_block->samples; + } + if (susp->s1_ptr != susp->s1_bptr->samples) { + stdputstr("bug in multiseq_advance\n"); + EXIT(1); + } + /* see if we've reached a logical stop + * (I can't believe this code block is in 3 places - + * there must be a better way... RBD) + */ + if (!susp->logical_stop_bits) { + if (susp->s1->logical_stop_cnt != UNKNOWN) { + if (susp->susp.current + susp->s1_cnt >= + susp->s1->logical_stop_cnt) { + susp->logical_stop_bits = 1; + susp->susp.log_stop_cnt = + susp->s1->logical_stop_cnt; + ms->not_logically_stopped_cnt--; +D nyquist_printf( + "snd_make_multiseq: Logical stop reached, not_logically_stopped_cnt %d\n", + ms->not_logically_stopped_cnt); + } + } + } +D nyquist_printf("\n\toutput block, current %d cnt %d ", + (int)susp->susp.current, (int)susp->s1_cnt); + } + if (!susp->logical_stop_bits) + my_hor = susp_time(susp, ms); + else my_hor = susp_log_stop_time(susp, ms); + if (new_horizon < my_hor) { +D nyquist_printf("new_horizon %g ", my_hor); + new_horizon = my_hor; + } + if (ms->not_logically_stopped_cnt == 0) { + ms->horizon = new_horizon; /* pass t0 to multiseq_convert */ +D stdputstr("Calling multiseq_convert\n"); + multiseq_convert(ms); + return; + } + my_low_water = susp_low_water(susp, ms); + if (my_low_water < new_low_water) { + new_low_water = my_low_water; + } +D stdputstr("\n"); + } + ms->low_water = new_low_water; + if (new_horizon <= ms->horizon) { + stdputstr("no progress in multiseq_advance\n"); + EXIT(1); + } else { + ms->horizon = new_horizon; + } + } +} + + +/* multiseq_convert -- eval closure and convert to adds */ +/**/ +void multiseq_convert(multiseq_type ms) +{ + LVAL result, new; + sound_type snd; + time_type now = ms->t0 + ms->horizon; + int i; + long size; + + xlsave1(result); + result = xleval(cons(ms->closure, consa(cvflonum(now)))); + if (exttypep(result, a_sound)) { + snd = sound_copy(getsound(result)); + result = newvector(ms->nchans); + setelement(result, 0, cvsound(snd)); + for (i = 1; i < ms->nchans; i++) { + setelement(result, i, cvsound(sound_zero(now, ms->sr))); + } + } else if (vectorp(result)) { + if (getsize(result) > ms->nchans) { + xlerror("too few channels", result); + } else if (getsize(result) < ms->nchans) { + new = newvector(ms->nchans); + for (i = 1; i < getsize(result); i++) { + setelement(new, i, getelement(result, i)); + } + for (i = getsize(result); i < ms->nchans; i++) { + setelement(new, i, cvsound(sound_zero(now, ms->sr))); + } + result = new; + } + } else xlerror("closure did not return a (multi-channel) sound", result); + + /* now result holds a vector of nchans, insert them into add_susp's */ + for (i = 0; i < ms->nchans; i++) { + snd_list_type snd_list = ms->chans[i]; + add_susp_type susp = (add_susp_type) snd_list->u.susp; + long sother_start; + + /* remove backpointer to ms */ + susp->multiseq = NULL; + susp->susp.print_tree = add_print_tree; + susp->susp.free = add_free; + susp->susp.mark = add_mark; + + susp->s2 = sound_copy(getsound(getelement(result, i))); + if (susp->s1->sr != susp->s2->sr) + xlfail("multiseq: sample rates must match"); + + if (susp->s2->scale != 1.0) { + susp->s2 = snd_make_normalize(susp->s2); + } + + sother_start = ROUND((susp->s2->t0 - susp->susp.t0) * susp->s2->sr); +D nyquist_printf("sother_start computed for %p: %d\n", + susp, (int)sother_start); + if (sother_start > susp->susp.current) { +D nyquist_printf("susp %p using add_s1_nn_fetch\n", susp); + susp->susp.fetch = add_s1_nn_fetch; + susp->susp.name = "multiseq:add_s1_nn_fetch"; + } else if (susp->terminate_bits) { /* s1 is done, just get s2 now */ + sound_unref(susp->s1); + susp->s1 = NULL; +D nyquist_printf("susp %p using add_s2_nn_fetch\n", susp); + susp->susp.fetch = add_s2_nn_fetch; + susp->susp.name = "multiseq:add_s2_nn_fetch"; + } else { +D nyquist_printf("susp %p using add_s1_s2_nn_fetch\n", susp); + susp->susp.fetch = add_s1_s2_nn_fetch; + susp->susp.name = "multiseq:add_s1_s2_nn_fetch"; + } + + /* fix up logical stop info */ + /* BUG: what if s2 is already stopped? */ + susp->susp.log_stop_cnt = UNKNOWN; + susp->logically_stopped = false; + + /* we need to compute at least 1 sample + * (at this point we don't really know if we've + * computed anything or not, so to be safe, do it. + */ + snd_list->u.next = snd_list_create(&(susp->susp)); + snd_list->block = internal_zero_block; + (*(susp->susp.fetch))(susp, snd_list); + } + + /* now free the multiseq struct */ + size = sizeof(snd_list_type) * ms->nchans; + ffree_generic(ms->chans, size, "multiseq_convert"); + ffree_generic(ms, sizeof(multiseq_node), "multiseq_convert(2)"); + + ms->closure = NIL; /* allow garbage collection now */ + xlpop(); +} + + +/* multiseq_fetch returns blocks of s1 until the logical stop time of s1's */ +/* + * Fetch routines (in particular, the add_*_fetch routines that will + * be installed on this susp at a later time) expect to be called with + * a new snd_list installed and ready for a new block. However, since + * we are going to call multiseq_advance to pull blocks out of susps + * that will not be set up with a fresh snd_list in this way, it is + * simpler to dispose of the preallocated snd_list so that all susps + * look alike to multiseq_advance. Of course, multiseq_advance will + * redo the work of allocating a snd_list. + * + * If a channel terminates early, we must be careful: continuing to + * fetch will return pointers to the zero_block, but this will + * indicate termination to whoever is fetching from multiseq. We + * must check the pointers and substitute internal_zero_block to + * avoid premature termination. + */ +void multiseq_fetch(susp, snd_list) + register add_susp_type susp; + snd_list_type snd_list; +{ + time_type block_end_time; + + /* undo the preallocation of a snd_list_node */ + /* we can bypass the reference counting code because we + * know that this snd_list was just allocated and has no + * other references + */ +#ifdef MULTISEQ_GC_DEBUG + if (snd_list_to_watch == snd_list->u.next) { + nyquist_printf("multiseq_fetch: backing out snd_list_to_watch from %p\n", + snd_list_to_watch); + watch_snd_list(snd_list); + } +#endif + ffree_snd_list(snd_list->u.next, "multiseq_fetch"); + snd_list->u.susp = (snd_susp_type) susp; + snd_list->block = NULL; + +D nyquist_printf("multiseq_fetch called: susp %p s1_cnt %d\n", + susp, (int)susp->s1_cnt); + + /* first compute how many samples we can generate from s1: */ + if (susp->s1_cnt == 0) { + susp_get_block_samples(s1, s1_bptr, s1_ptr, s1_cnt); + if (susp->s1_ptr == zero_block->samples) { + susp->terminate_bits = 1; /* mark s1 as terminated */ + susp->s1_bptr = internal_zero_block; + susp->s1_ptr = internal_zero_block->samples; + } + /* see if we've reached a logical stop + * (I can't believe this code block is in 3 places - + * there must be a better way... RBD) + */ + if (!susp->logical_stop_bits) { + if (susp->s1->logical_stop_cnt != UNKNOWN) { + if (susp->susp.current + susp->s1_cnt >= + susp->s1->logical_stop_cnt) { + susp->logical_stop_bits = 1; + susp->susp.log_stop_cnt = + susp->s1->logical_stop_cnt; + susp->multiseq->not_logically_stopped_cnt--; +D nyquist_printf( + "snd_make_multiseq: Logical stop reached, not_logically_stopped_cnt %d\n", + susp->multiseq->not_logically_stopped_cnt); + } + } + } + } + /* s1_cnt has the number of samples we can return */ + + /* now compute time of the last sample */ + block_end_time = susp_time(susp, susp->multiseq); +D nyquist_printf("block_end_time of %p: %g\n", susp, block_end_time); + multiseq_advance(susp->multiseq, block_end_time); +} + + +/* multiseq_mark -- mark routine for multiseq susps */ +/**/ +void multiseq_mark(add_susp_type susp) +{ + int i; + multiseq_type ms = susp->multiseq; +D nyquist_printf("multiseq_mark(%p)\n", susp); +/* nyquist_printf("marking s1@%p in add@%p\n", susp->s1, susp);*/ + if (ms->closure) mark(ms->closure); + + /* mark s1 of each susp in multiseq */ + for (i = 0; i < ms->nchans; i++) { + snd_list_type snd_list = ms->chans[i]; + if (snd_list) { + while (snd_list->block != NULL) { + if (snd_list == zero_snd_list) break; + snd_list = snd_list->u.next; + } + sound_xlmark(((add_susp_type) snd_list->u.susp)->s1); + } + } +} + + +/* snd_make_multiseq -- make a multiseq from an array and a closure */ +/* + * NOTE: the resulting array of sounds will not use the normal + * SND_get_first and SND_get_next routines to fetch new blocks + * because these extend the snd_list of the sound immediately, + * and this would confuse multiseq_advance() which has to extend + * multiple snd_lists synchronously. So, we use multiseq_get_next() + * instead. + */ +LVAL snd_make_multiseq(LVAL s1, LVAL closure) +{ + multiseq_type ms; + int i; + LVAL result; + + xlsave1(result); + + /* allocate multiseq */ + falloc_generic(ms, multiseq_node, "snd_make_multiseq"); + + /* install its array of snd_list_type */ + if (!vectorp(s1) || getsize(s1) == 0) { + ffree_generic(ms, sizeof(multiseq_node), "snd_make_multiseq"); + xlerror("bad argument type", s1); + } + ms->nchans = getsize(s1); + ms->closure = closure; + ms->not_logically_stopped_cnt = 0; + ms->low_water = 0.0; + ms->horizon = 0.0; + falloc_generic_n(ms->chans, snd_list_type, ms->nchans, + "snd_make_multiseq"); + + /* allocate sounds to return */ + result = newvector(ms->nchans); + + /* ms->t0 will be the minimum of all t0's in array */ + ms->t0 = (getsound(getelement(s1, 0)))->t0; + + /* create sounds to return */ + for (i = 0; i < ms->nchans; i++) { + add_susp_type susp; + sound_type snd; + falloc_generic(susp, add_susp_node, "snd_make_multiseq(add_susp)"); + susp->s1 = sound_copy(getsound(getelement(s1, i))); + /* we used to only incr this if lsc was UNKNOWN, but + that's wrong. Should move this out of the loop now. + */ + if (susp->s1->scale != 1.0) { + /* stdputstr("normalizing first sound in a seq\n"); */ + susp->s1 = snd_make_normalize(susp->s1); + } + + ms->not_logically_stopped_cnt++; +D nyquist_printf("snd_make_multiseq: not_logically_stopped_cnt %d\n", + ms->not_logically_stopped_cnt); + susp->s1_cnt = 0; + susp->s2 = NULL; + susp->s2_cnt = 0; + susp->susp.fetch = multiseq_fetch; + susp->susp.free = multiseq_free; + susp->susp.sr = susp->s1->sr; + susp->susp.mark = multiseq_mark; + susp->susp.print_tree = multiseq_print_tree; + susp->susp.name = "multiseq"; + susp->susp.t0 = susp->s1->t0; + susp->terminate_bits = 0; /* bits for s1 and s2 termination */ + susp->terminate_cnt = UNKNOWN; + susp->logical_stop_bits = 0; /* bits for s1 and s2 log. stop */ + susp->susp.log_stop_cnt = UNKNOWN; + susp->logically_stopped = false; + susp->started = false; + susp->susp.current = 0; + susp->multiseq = ms; + snd = sound_create((snd_susp_type) susp, susp->s1->t0, susp->susp.sr, + 1.0); +#ifdef GC_DEBUG + if (snd == sound_to_watch) { + nyquist_printf("watched sound is channel %d\n", i); + } +#endif + setelement(result, i, cvsound(snd)); + if (snd->list->block || !snd->list->u.susp) { + stdputstr("data inconsistency in snd_make_seq\n"); + EXIT(1); + } + ms->chans[i] = snd->list; +D nyquist_printf("ms->chans[%d] = %p, %p->u.susp = %p\n", + i, snd->list, snd->list, snd->list->u.susp); + ms->t0 = MIN(ms->t0, susp->s1->t0); + ms->sr = susp->s1->sr; /* assume all samp rates are equal */ +D nyquist_printf("Multiseq sound[%d]: \n", i); +D sound_print_tree(susp->s1); + } +D nyquist_printf("ms->t0 == %g\n", ms->t0); + xlpop(); + return result; +} + + +/* note: snd_multiseq is a noop, just call snd_make_multiseq */ + +void multiseq_free(add_susp_type susp) +{ + int i; + multiseq_type ms = susp->multiseq; + boolean dead = true; + sound_unref(susp->s1); + sound_unref(susp->s2); /* probably not necessary */ + /* tricky part: remove pointer from ms->chans */ + for (i = 0; i < ms->nchans; i++) { + if (ms->chans[i]) { + dead = false; + /* + * note that ms->chans is still a valid + * pointer (see snd_list_unref) + */ + if (ms->chans[i]->u.susp == (snd_susp_type) susp) { + ms->chans[i] = NULL; +D nyquist_printf("susp %p freed, ms@%p->chans[%d] = NULL\n", + susp, ms, i); + } + } + } + + /* if last element is freed, free the multiseq struct too */ + if (dead) { + i = sizeof(snd_list_type) * ms->nchans; + ffree_generic(ms->chans, i, "multiseq_free"); + ffree_generic(ms, sizeof(multiseq_node), "multiseq_free(2)"); + } + + susp->multiseq = NULL; /* just to be safe */ + ffree_generic(susp, sizeof(add_susp_node), "multiseq_free(3)"); +} + + +void multiseq_print_tree(add_susp_type susp, int n) +{ + int i; + + indent(n); + if (!susp->multiseq) { + xlfail("internal error: missing multiseq structure"); + } + nyquist_printf("multiseq@%p = [ ", susp->multiseq); + for (i = 0; i < susp->multiseq->nchans; i++) { + if (susp->multiseq->chans[i]) { + nyquist_printf("%p", susp->multiseq->chans[i]->u.susp); + } else { + stdputstr("NULL"); + } + } + + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("closure:"); + stdprint(susp->multiseq->closure); + + indent(n); +} + + diff --git a/nyqsrc/multiseq.h b/nyqsrc/multiseq.h new file mode 100644 index 0000000..921ba24 --- /dev/null +++ b/nyqsrc/multiseq.h @@ -0,0 +1,19 @@ +/* this typedef goes here because it is needed by add */ + +typedef struct multiseq_struct { + int not_logically_stopped_cnt; + int nchans; + /* greatest lower bound on logical stop time: */ + time_type horizon; + /* lowest time corresp to sample count on a snd_list: */ + time_type low_water; + snd_list_type *chans; + time_type t0; + rate_type sr; + LVAL closure; +} multiseq_node, *multiseq_type; + + + +LVAL snd_make_multiseq(LVAL s1, LVAL closure); + /* LISP: (SND-MULTISEQ ANY ANY) */ diff --git a/nyqsrc/nfilterkit.c b/nyqsrc/nfilterkit.c new file mode 100644 index 0000000..00e7f65 --- /dev/null +++ b/nyqsrc/nfilterkit.c @@ -0,0 +1,199 @@ +/* + * nfilterkit.c - windowed low-pass filter support. + * adapted from filterkit.c, by Julius Smith et al., CCRMA, Stanford University + * + +/* + * FilterUp() - Applies a filter to a given sample when up-converting. + * FilterUD() - Applies a filter to a given sample when up- or down- + * converting. + */ + +#include "soundstruct.h" +#include "nresample.h" +#include "nfilterkit.h" + +/* #include <libc.h> */ +#include <stdio.h> +#include <math.h> +#include <string.h> + + +#include <math.h> + +fast_float FilterUp(float Imp[], float ImpD[], + UHWORD Nwing, BOOL Interp, + float *Xp, double Ph, HWORD Inc) +{ + float *Hp, *Hdp = NULL, *End; + fast_float a = 0; + fast_float v, t; + double exact_index = Ph * Npc; + long index = exact_index; /* convert fraction to filter index */ + +/* printf("FilterUp, Inc %d, phase %g\n", Inc, Ph); */ + v=0; + Hp = &Imp[index]; + End = &Imp[Nwing]; + if (Interp) { + Hdp = &ImpD[index]; + a = exact_index - index; +/* printf("fraction %g\n", a); */ + } + if (Inc == 1) /* If doing right wing... */ + { /* ...drop extra coeff, so when Ph is */ + End--; /* 0.5, we don't do too many mult's */ + if (Ph == 0) /* If the phase is zero... */ + { /* ...then we've already skipped the */ + printf("Ph == 0\n"); + Hp += Npc; /* first sample, so we must also */ + Hdp += Npc; /* skip ahead in Imp[] and ImpD[] */ + } + } + if (Interp) { + while (Hp < End) { + t = *Hp; /* Get filter coeff */ + /* t scaled by 2^(16 + NLpScl)/LpScl */ +/* printf("coeff %g ", t); */ + t += *Hdp *a; /* t is now interp'd filter coeff */ +/* printf("interp'd coeff %g ", t);*/ + Hdp += Npc; /* Filter coeff differences step */ +/* printf("input sample %g ", *Xp); */ + t *= *Xp; /* Mult coeff by input sample */ + /* t scaled by 2^(16 + NLpScl)/LpScl */ +/* printf("product %g\n", t); */ + v += t; /* The filter output */ + Hp += Npc; /* Filter coeff step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + } + } else { + while (Hp < End) { + t = *Hp; /* Get filter coeff */ + t *= *Xp; /* Mult coeff by input sample */ + v += t; /* The filter output */ + Hp += Npc; /* Filter coeff step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + } + } +/* printf("FilterUp, Inc %d returns %g\n", Inc, v); */ + return(v); +} + +fast_float FilterUD( float Imp[], float ImpD[], + UHWORD Nwing, BOOL Interp, + float *Xp, double Ph, HWORD Inc, double dhb) +{ + double a; + float *Hp, *Hdp, *End; + fast_float v, t; + double Ho; + + v=0; + Ho = Ph*dhb; + End = &Imp[Nwing]; + if (Inc == 1) /* If doing right wing... */ + { /* ...drop extra coeff, so when Ph is */ + End--; /* 0.5, we don't do too many mult's */ + if (Ph == 0) /* If the phase is zero... */ + Ho += dhb; /* ...then we've already skipped the */ + } /* first sample, so we must also */ + /* skip ahead in Imp[] and ImpD[] */ + if (Interp) { + long HoIndex = Ho; + while ((Hp = &Imp[HoIndex]) < End) { + t = *Hp; /* Get IR sample */ + Hdp = &ImpD[HoIndex]; /* get interp (lower Na) bits from diff table*/ + a = Ho - HoIndex; /* a is logically between 0 and 1 */ + t += *Hdp * a; /* t is now interp'd filter coeff */ + t *= *Xp; /* Mult coeff by input sample */ + v += t; /* The filter output */ + Ho += dhb; /* IR step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + HoIndex = Ho; + } + } else { + long HoIndex = Ho; + while ((Hp = &Imp[HoIndex]) < End) { + t = *Hp; /* Get IR sample */ + t *= *Xp; /* Mult coeff by input sample */ + v += t; /* The filter output */ + Ho += dhb; /* IR step */ + Xp += Inc; /* Input signal step. NO CHECK ON BOUNDS */ + HoIndex = Ho; + } + } + return(v); +} + +/* Sampling rate up-conversion only subroutine; + * Slightly faster than down-conversion; + */ +static int SrcUp(float X[], float Y[], double factor, double *Time, + UHWORD Nx, UHWORD Nwing, double LpScl, + float Imp[], float ImpD[], BOOL Interp) +{ + mem_float *Xp, *Ystart; + fast_float v; + + double dt; /* Step through input signal */ + double endTime; /* When Time reaches EndTime, return to user */ + +/* printf("SrcUp: interpFilt %d\n", Interp);*/ + + dt = 1.0/factor; /* Output sampling period */ + + Ystart = Y; + endTime = *Time + Nx; + while (*Time < endTime) + { + long iTime = *Time; + Xp = &X[iTime]; /* Ptr to current input sample */ + /* Perform left-wing inner product */ + v = FilterUp(Imp, ImpD, Nwing, Interp, Xp, *Time - iTime, -1); + /* Perform right-wing inner product */ + v += FilterUp(Imp, ImpD, Nwing, Interp, Xp+1, + (1 + iTime) - *Time, 1); + v *= LpScl; /* Normalize for unity filter gain */ +/* printf("SrcUp output sample %g\n", v); */ + *Y++ = v; + *Time += dt; /* Move to next sample by time increment */ + } + return (Y - Ystart); /* Return the number of output samples */ +} + + +/* Sampling rate conversion subroutine */ + +static int SrcUD(float X[], float Y[], double factor, double *Time, + UHWORD Nx, UHWORD Nwing, double LpScl, + float Imp[], float ImpD[], BOOL Interp) +{ + mem_float *Xp, *Ystart; + fast_float v; + + double dh; /* Step through filter impulse response */ + double dt; /* Step through input signal */ + double endTime; /* When Time reaches EndTime, return to user */ + + dt = 1.0/factor; /* Output sampling period */ + + dh = MIN(Npc, factor*Npc); /* Filter sampling period */ + + Ystart = Y; + endTime = *Time + Nx; + while (*Time < endTime) + { + long iTime = *Time; + Xp = &X[iTime]; /* Ptr to current input sample */ + v = FilterUD(Imp, ImpD, Nwing, Interp, Xp, *Time - iTime, + -1, dh); /* Perform left-wing inner product */ + v += FilterUD(Imp, ImpD, Nwing, Interp, Xp+1, (1 + iTime) - *Time, + 1, dh); /* Perform right-wing inner product */ + v *= LpScl; /* Normalize for unity filter gain */ + *Y++ = v; + *Time += dt; /* Move to next sample by time increment */ + } + return (Y - Ystart); /* Return the number of output samples */ +} + + diff --git a/nyqsrc/nfilterkit.h b/nyqsrc/nfilterkit.h new file mode 100644 index 0000000..b7343e5 --- /dev/null +++ b/nyqsrc/nfilterkit.h @@ -0,0 +1,80 @@ +/* nfilterkit.h -- header for adapted version of filterkit */ + +typedef char BOOL; +typedef short HWORD; +typedef unsigned short UHWORD; +typedef int WORD; +typedef unsigned int UWORD; + +#define MAX_HWORD (32767) +#define MIN_HWORD (-32768) + +#ifdef DEBUG +#define INLINE +#else DEBUG +/* #define INLINE inline */ +#define INLINE +#endif DEBUG + +/* + * FilterUp() - Applies a filter to a given sample when up-converting. + * FilterUD() - Applies a filter to a given sample when up- or down- + */ + +/* Conversion constants */ +#define Nhc 8 +#define Np (Nhc+Na) + +/* Description of constants: + * + * Npc - is the number of look-up values available for the lowpass filter + * between the beginning of its impulse response and the "cutoff time" + * of the filter. The cutoff time is defined as the reciprocal of the + * lowpass-filter cut off frequence in Hz. For example, if the + * lowpass filter were a sinc function, Npc would be the index of the + * impulse-response lookup-table corresponding to the first zero- + * crossing of the sinc function. (The inverse first zero-crossing + * time of a sinc function equals its nominal cutoff frequency in Hz.) + * Npc must be a power of 2 due to the details of the current + * implementation. The default value of 512 is sufficiently high that + * using linear interpolation to fill in between the table entries + * gives approximately 16-bit accuracy in filter coefficients. + * + * Nhc - is log base 2 of Npc. + * + * Na - is the number of bits devoted to linear interpolation of the + * filter coefficients. + * + * Np - is Na + Nhc, the number of bits to the right of the binary point + * in the integer "time" variable. To the left of the point, it indexes + * the input array (X), and to the right, it is interpreted as a number + * between 0 and 1 sample of the input X. Np must be less than 16 in + * this implementation. + * + * Nh - is the number of bits in the filter coefficients. The sum of Nh and + * the number of bits in the input data (typically 16) cannot exceed 32. + * Thus Nh should be 16. The largest filter coefficient should nearly + * fill 16 bits (32767). + * + * Nb - is the number of bits in the input data. The sum of Nb and Nh cannot + * exceed 32. + * + * Nhxn - is the number of bits to right shift after multiplying each input + * sample times a filter coefficient. It can be as great as Nh and as + * small as 0. Nhxn = Nh-2 gives 2 guard bits in the multiply-add + * accumulation. If Nhxn=0, the accumulation will soon overflow 32 bits. + * + * Nhg - is the number of guard bits in mpy-add accumulation (equal to Nh-Nhxn) + * + * NLpScl - is the number of bits allocated to the unity-gain normalization + * factor. The output of the lowpass filter is multiplied by LpScl and + * then right-shifted NLpScl bits. To avoid overflow, we must have + * Nb+Nhg+NLpScl < 32. + */ + + +fast_float FilterUp(mem_float Imp[], mem_float ImpD[], UHWORD Nwing, BOOL Interp, + mem_float *Xp, double Ph, HWORD Inc); + +fast_float FilterUD(mem_float Imp[], mem_float ImpD[], UHWORD Nwing, BOOL Interp, + mem_float *Xp, double Ph, HWORD Inc, double dhb); diff --git a/nyqsrc/nyq-osc-server.c b/nyqsrc/nyq-osc-server.c new file mode 100644 index 0000000..49cc0ae --- /dev/null +++ b/nyqsrc/nyq-osc-server.c @@ -0,0 +1,112 @@ +/* nosc-server.c -- an OSC server for Nyquist */ +/* + * this enables OSC clients to set slider values in Nyquist + * for security reasons, OSC clients cannot invoke Lisp expressions + * the only operation allowed is to set a value in a Lisp array + * + * The API is: + * + * int nosc_init() -- initialize the server, return error, 0 means none + * int nosc_poll() -- poll for messages and process them, return error, 0 means none + * void nosc_finish() -- free data structures, return error, 0 means none + */ + +#ifdef OSC +#ifdef WIN32 +#include <winsock2.h> +#include <malloc.h> +#include <process.h> +#else +#include <stdlib.h> +#include <sys/time.h> +#include <sys/types.h> +#include <strings.h> +#include <unistd.h> +#include <stdio.h> +#endif +#include "xlisp.h" +#include "sound.h" /* to get nosc_enabled */ +#include "lo/lo.h" +#include "sliders.h" + +static lo_server the_server = NULL; +static int lo_fd; + +static void error(int num, const char *msg, const char *path) +{ + char s[256]; + sprintf(s, "liblo server error %d in path %s: %s\n", num, path, msg); + stdputstr(s); +} + + +static int slider_handler(const char *path, const char *types, lo_arg **argv, + int argc, void *data, void *user_data) +{ + // printf("%s <- %d, %g\n", path, argv[0]->i, argv[1]->f); + // fflush(stdout); + set_slider(argv[0]->i, argv[1]->f); + return 0; +} + +// wii_orientation_handler -- controls sliders 0 and 1 in range [0, 1] +// using wii orientation messages from OSC +static int wii_orientation_handler(const char *path, const char *types, + lo_arg **argv, int argc, void *data, + void *user_data) +{ + set_slider(0, min(1.0F, max(0.0F, (argv[0]->f / 180) + 0.5))); + set_slider(1, min(1.0F, max(0.0F, (argv[1]->f / 180) + 0.5))); + return 0; +} + + +int nosc_init() +{ + the_server = lo_server_new("7770", error); + /* add method that will match the path /slider, with two numbers, coerced + * to int and float */ + lo_server_add_method(the_server, "/slider", "if", slider_handler, NULL); + lo_server_add_method(the_server, "/wii/orientation", "ff", + wii_orientation_handler, NULL); + lo_fd = lo_server_get_socket_fd(the_server); + nosc_enabled = true; + return 0; +} + + +int nosc_poll() +{ + fd_set rfds; + struct timeval tv; + int retval; + + // loop, receiving all pending OSC messages + while (true) { + FD_ZERO(&rfds); + FD_SET(lo_fd, &rfds); + tv.tv_sec = 0; + tv.tv_usec = 0; + + retval = select(lo_fd + 1, &rfds, NULL, NULL, &tv); + if (retval == -1) { + stdputstr("select() error in nosc_poll\n"); + return -1; + } else if (retval > 0 && FD_ISSET(lo_fd, &rfds)) { + /* printf("lo_server_recv_noblock 1\n"); */ + lo_server_recv_noblock(the_server, 0); + } else { + return 0; + } + } +} + + +void nosc_finish() +{ + lo_server_free(the_server); + nosc_enabled = false; +} + +#endif + diff --git a/nyqsrc/nyq-osc-server.h b/nyqsrc/nyq-osc-server.h new file mode 100644 index 0000000..655c7b5 --- /dev/null +++ b/nyqsrc/nyq-osc-server.h @@ -0,0 +1,9 @@ +/* + * nyq-osc-server.h + * nyquist + * + * Created by Roger Dannenberg on 10/1/06. + * Copyright 2006 __MyCompanyName__. All rights reserved. + * + */ + diff --git a/nyqsrc/nyx.c b/nyqsrc/nyx.c new file mode 100644 index 0000000..4cc1fea --- /dev/null +++ b/nyqsrc/nyx.c @@ -0,0 +1,1294 @@ +/********************************************************************** + + nyx.c + + Nyx: A very simple external interface to Nyquist + + Dominic Mazzoni + +**********************************************************************/ + +/* system includes */ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <errno.h> +#include <math.h> + +#ifndef WIN32 +#include <unistd.h> +#endif + +/* nyx includes */ +#include "nyx.h" + +/* xlisp includes */ +#include "switches.h" +#include "xlisp.h" +#include "cext.h" + +/* nyquist includes */ +#include "sound.h" +#include "samples.h" +#include "falloc.h" + +/* use full copy */ +#define NYX_FULL_COPY 1 + +/* show memory stats */ +// #define NYX_MEMORY_STATS 1 + +/* show details of obarray copy */ +// #define NYX_DEBUG_COPY 1 + +/* macro to compute the size of a segment (taken from xldmem.h) */ +#define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node)) + +/* xldmem external variables */ +extern long nnodes; +extern long nfree; +extern long total; +extern int nsegs; +extern SEGMENT *segs; +extern SEGMENT *lastseg; +extern LVAL fnodes; + +/* nyquist externs */ +extern LVAL a_sound; +extern snd_list_type zero_snd_list; + +/* globals */ +LOCAL nyx_os_callback nyx_os_cb = NULL; +LOCAL void *nyx_os_ud; +LOCAL nyx_output_callback nyx_output_cb; +LOCAL void *nyx_output_ud; +LOCAL int nyx_expr_pos; +LOCAL int nyx_expr_len; +LOCAL const char *nyx_expr_string; +LOCAL LVAL nyx_result; +LOCAL nyx_rval nyx_result_type = nyx_error; +LOCAL XLCONTEXT nyx_cntxt; +LOCAL int nyx_first_time = 1; +LOCAL LVAL nyx_obarray; +LOCAL FLOTYPE nyx_warp_stretch; + +/* Suspension node */ +typedef struct nyx_susp_struct { + snd_susp_node susp; // Must be first + nyx_audio_callback callback; + void *userdata; + long len; + int channel; +} nyx_susp_node, *nyx_susp_type; + +#if defined(NYX_DEBUG_COPY) && NYX_DEBUG_COPY +static const char *_types_[] = +{ + "FREE_NODE", + "SUBR", + "FSUBR", + "CONS", + "SYMBOL", + "FIXNUM", + "FLONUM", + "STRING", + "OBJECT", + "STREAM", + "VECTOR", + "CLOSURE", + "CHAR", + "USTREAM", + "EXTERN" +}; + +// Dump the contents of the obarray +LOCAL void nyx_show_obarray() +{ + LVAL array = getvalue(obarray); + LVAL sym; + int i; + + for (i = 0; i < HSIZE; i++) { + for (sym = getelement(array, i); sym; sym = cdr(sym)) { + LVAL syma = car(sym); + + printf("_sym_ = "); + xlprint(getvalue(s_stdout), syma, TRUE); + + if (getvalue(syma)) { + printf(" _type_ = %s _val_ = ", _types_[ntype(getvalue(syma))]); + xlprint(getvalue(s_stdout), getvalue(syma), TRUE); + } + + if (getfunction(syma)) { + printf(" _type_ = %s _fun_ = ", _types_[ntype(getfunction(syma))]); + xlprint(getvalue(s_stdout), getfunction(syma), TRUE); + } + + printf("\n"); + } + } +} +#endif + +// +// Free empty segments +// +LOCAL void freesegs() +{ + SEGMENT *seg; + SEGMENT *next; + + // Free up as many nodes as possible + gc(); + + // Reset free node tracking + fnodes = NIL; + nfree = 0L; + + // Reset the last segment pointer + lastseg = NULL; + + // Scan all segments + for (seg = segs; seg != NULL; seg = next) { + int n = seg->sg_size; + int empty = TRUE; + int i; + LVAL p; + + // Check this segment for in-use nodes + p = &seg->sg_nodes[0]; + for (i = n; --i >= 0; ++p) { + if (ntype(p) != FREE_NODE) { + empty = FALSE; + break; + } + } + + // Retain pointer to next segment + next = seg->sg_next; + + // Was the current segment empty? + if (empty) { + // Free the segment; + free((void *) seg); + + // Unlink it from the list. No need to worry about a NULL lastseg + // pointer here since the fixnum and char segments will always exist + // at the head of the list and they will always have nodes. So, lastseg + // will have been set before we find any empty nodes. + lastseg->sg_next = next; + + // Reduce the stats + total -= (long) segsize(n); + nsegs--; + nnodes -= n; + } + else { + // Not empty, so remember this node as the last segment + lastseg = seg; + + // Add all of the free nodes in this segment to the free list + p = &seg->sg_nodes[0]; + for (i = n; --i >= 0; ++p) { + if (ntype(p) == FREE_NODE) { + rplaca(p, NIL); + rplacd(p, fnodes); + fnodes = p; + nfree++; + } + } + } + } +} + +#if defined(NYX_FULL_COPY) && NYX_FULL_COPY + +// Copy a node (recursively if appropriate) +LOCAL LVAL nyx_dup_value(LVAL val) +{ + LVAL nval = val; + + // Protect old and new values + xlprot1(val); + xlprot1(nval); + + // Copy the node + if (val != NIL) { + switch (ntype(val)) + { + case FIXNUM: + nval = cvfixnum(getfixnum(val)); + break; + + case FLONUM: + nval = cvflonum(getflonum(val)); + break; + + case CHAR: + nval = cvchar(getchcode(val)); + break; + + case STRING: + nval = cvstring((char *) getstring(val)); + break; + + case VECTOR: + { + int len = getsize(val); + int i; + + nval = newvector(len); + nval->n_type = ntype(val); + + for (i = 0; i < len; i++) { + if (getelement(val, i) == val) { + setelement(nval, i, val); + } + else { + setelement(nval, i, nyx_dup_value(getelement(val, i))); + } + } + } + break; + + case CONS: + nval = cons(nyx_dup_value(car(val)), nyx_dup_value(cdr(val))); + break; + + case SUBR: + case FSUBR: + nval = cvsubr(getsubr(val), ntype(val), getoffset(val)); + break; + + // Symbols should never be copied since their addresses are cached + // all over the place. + case SYMBOL: + nval = val; + break; + + // Streams are not copied (although USTREAM could be) and reference + // the original value. + case USTREAM: + case STREAM: + nval = val; + break; + + // Externals aren't copied because I'm not entirely certain they can be. + case EXTERN: + nval = val; + break; + + // For all other types, just allow them to reference the original + // value. Probably not the right thing to do, but easier. + case OBJECT: + case CLOSURE: + default: + nval = val; + break; + } + } + + xlpop(); + xlpop(); + + return nval; +} + +// Make a copy of the original obarray, leaving the original in place +LOCAL void nyx_save_obarray() +{ + LVAL newarray; + int i; + + // This provide permanent protection for nyx_obarray as we do not want it + // to be garbage-collected. + xlprot1(nyx_obarray); + nyx_obarray = getvalue(obarray); + + // Create and set the new vector. This allows us to use xlenter() to + // properly add the new symbol. Probably slower than adding directly, + // but guarantees proper hashing. + newarray = newvector(HSIZE); + setvalue(obarray, newarray); + + // Scan all obarray vectors + for (i = 0; i < HSIZE; i++) { + LVAL sym; + + // Scan all elements + for (sym = getelement(nyx_obarray, i); sym; sym = cdr(sym)) { + LVAL syma = car(sym); + char *name = (char *) getstring(getpname(syma)); + LVAL nsym = xlenter(name); + + // Ignore *OBARRAY* since there's no need to copy it + if (strcmp(name, "*OBARRAY*") == 0) { + continue; + } + + // Duplicate the symbol's values + setvalue(nsym, nyx_dup_value(getvalue(syma))); + setplist(nsym, nyx_dup_value(getplist(syma))); + setfunction(nsym, nyx_dup_value(getfunction(syma))); + } + } + + // Swap the obarrays, so that the original is put back into service + setvalue(obarray, nyx_obarray); + nyx_obarray = newarray; +} + +// Restore the symbol values to their original value and remove any added +// symbols. +LOCAL void nyx_restore_obarray() +{ + LVAL obvec = getvalue(obarray); + int i; + + // Scan all obarray vectors + for (i = 0; i < HSIZE; i++) { + LVAL last = NULL; + LVAL dcon; + + for (dcon = getelement(obvec, i); dcon; dcon = cdr(dcon)) { + LVAL dsym = car(dcon); + char *name = (char *)getstring(getpname(dsym)); + LVAL scon; + + // Ignore *OBARRAY* since setting it causes the input array to be + // truncated. + if (strcmp(name, "*OBARRAY*") == 0) { + continue; + } + + // Find the symbol in the original obarray. + for (scon = getelement(nyx_obarray, hash(name, HSIZE)); scon; scon = cdr(scon)) { + LVAL ssym = car(scon); + + // If found, then set the current symbols value to the original. + if (strcmp(name, (char *)getstring(getpname(ssym))) == 0) { + setvalue(dsym, nyx_dup_value(getvalue(ssym))); + setplist(dsym, nyx_dup_value(getplist(ssym))); + setfunction(dsym, nyx_dup_value(getfunction(ssym))); + break; + } + } + + // If we didn't find the symbol in the original obarray, then it must've + // been added since and must be removed from the current obarray. + if (scon == NULL) { + if (last) { + rplacd(last, cdr(dcon)); + } + else { + setelement(obvec, i, cdr(dcon)); + } + } + + // Must track the last dcon for symbol removal + last = dcon; + } + } +} + +#else + +LOCAL LVAL copylist(LVAL from) +{ + LVAL nsym; + if (from == NULL) { + return NULL; + } + + return cons(car(from), copylist(cdr(from))); +} + +/* Make a copy of the obarray so that we can erase any + changes the user makes to global variables */ +LOCAL void nyx_copy_obarray() +{ + LVAL newarray; + int i; + + // Create and set the new vector. + newarray = newvector(HSIZE); + setvalue(obarray, newarray); + + for (i = 0; i < HSIZE; i++) { + LVAL from = getelement(nyx_obarray, i); + if (from) { + setelement(newarray, i, copylist(from)); + } + } +} + +#endif + +void nyx_init() +{ + if (nyx_first_time) { + char *argv[1]; + argv[0] = "nyquist"; + xlisp_main_init(1, argv); + + nyx_os_cb = NULL; + nyx_output_cb = NULL; + + nyx_first_time = 0; + +#if defined(NYX_FULL_COPY) && NYX_FULL_COPY + // Save a copy of the original obarray's contents. + nyx_save_obarray(); +#else + // Permanently protect the original obarray value. This is needed since + // it would be unreferenced in the new obarray and would be garbage + // collected. We want to keep it around so we can make copies of it to + // refresh the execution state. + xlprot1(nyx_obarray); + nyx_obarray = getvalue(obarray); +#endif + } + +#if !defined(NYX_FULL_COPY) || !NYX_FULL_COPY + // Create a copy of the original obarray + nyx_copy_obarray(); +#endif + + // Keep nyx_result from being garbage-collected + xlprot1(nyx_result); + +#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS + printf("\nnyx_init\n"); + xmem(); +#endif +} + +void nyx_cleanup() +{ + // Garbage-collect nyx_result + xlpop(); + +#if defined(NYX_FULL_COPY) && NYX_FULL_COPY + + // Restore the original symbol values + nyx_restore_obarray(); + +#else + + // Restore obarray to original state...but not the values + setvalue(obarray, nyx_obarray); + +#endif + + // Make sure the sound nodes can be garbage-collected. Sounds are EXTERN + // nodes whose value does not get copied during a full copy of the obarray. + setvalue(xlenter("S"), NIL); + + // Free excess memory segments - does a gc() + freesegs(); + + // No longer need the callbacks + nyx_output_cb = NULL; + nyx_os_cb = NULL; + +#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS + printf("\nnyx_cleanup\n"); + xmem(); +#endif +} + +LOCAL void nyx_susp_fetch(register nyx_susp_type susp, snd_list_type snd_list) +{ + sample_block_type out; + sample_block_values_type out_ptr; + long n; + int err; + + falloc_sample_block(out, "nyx_susp_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + n = max_sample_block_len; + if (susp->susp.current + n > susp->len) + n = susp->len - susp->susp.current; + + err = susp->callback(out_ptr, susp->channel, + susp->susp.current, n, 0, susp->userdata); + if (err) { + // The user canceled or some other error occurred, so we use + // xlsignal() to jump back to our error handler. + xlsignal(NULL, NULL); + // never get here. + } + + snd_list->block_len = (short)n; + susp->susp.current += n; + + if (n == 0) { + /* we didn't read anything, but can't return length zero, so + convert snd_list to pointer to zero block */ + snd_list_terminate(snd_list); + } + else if (n < max_sample_block_len) { + /* should free susp */ + snd_list_unref(snd_list->u.next); + /* if something is in buffer, terminate by pointing to zero block */ + snd_list->u.next = zero_snd_list; + } +} + +LOCAL void nyx_susp_free(nyx_susp_type susp) +{ + ffree_generic(susp, sizeof(nyx_susp_node), "nyx_susp_free"); +} + +LOCAL void nyx_susp_print_tree(nyx_susp_type susp, int n) +{ +} + +void nyx_capture_output(nyx_output_callback callback, void *userdata) +{ + nyx_output_cb = callback; + nyx_output_ud = userdata; +} + +void nyx_set_audio_params(double rate, long len) +{ + double stretch_len = (len > 0 ? len / rate : 1.0); + LVAL warp; + + /* Bind the sample rate to the "*sound-srate*" global */ + setvalue(xlenter("*SOUND-SRATE*"), cvflonum(rate)); + + /* Bind selection len to "len" global */ + setvalue(xlenter("LEN"), cvflonum(len)); + + /* Set the "*warp*" global based on the length of the audio */ + xlprot1(warp); + warp = cons(cvflonum(0), /* time offset */ + cons(cvflonum(stretch_len), /* time stretch */ + cons(NULL, /* cont. time warp */ + NULL))); + setvalue(xlenter("*WARP*"), warp); + xlpop(); +} + +void nyx_set_input_audio(nyx_audio_callback callback, + void *userdata, + int num_channels, + long len, double rate) +{ + sample_type scale_factor = 1.0; + time_type t0 = 0.0; + nyx_susp_type *susp; + sound_type *snd; + int ch; + + nyx_set_audio_params(rate, len); + + susp = (nyx_susp_type *)malloc(num_channels * sizeof(nyx_susp_type)); + snd = (sound_type *)malloc(num_channels * sizeof(sound_type)); + + for(ch=0; ch < num_channels; ch++) { + falloc_generic(susp[ch], nyx_susp_node, "nyx_set_input_audio"); + + susp[ch]->callback = callback; + susp[ch]->userdata = userdata; + susp[ch]->len = len; + susp[ch]->channel = ch; + + susp[ch]->susp.fetch = nyx_susp_fetch; + susp[ch]->susp.keep_fetch = NULL; + susp[ch]->susp.free = nyx_susp_free; + susp[ch]->susp.mark = NULL; + susp[ch]->susp.print_tree = nyx_susp_print_tree; + susp[ch]->susp.name = "nyx"; + susp[ch]->susp.toss_cnt = 0; + susp[ch]->susp.current = 0; + susp[ch]->susp.sr = rate; + susp[ch]->susp.t0 = t0; + susp[ch]->susp.log_stop_cnt = 0; + + snd[ch] = sound_create((snd_susp_type)susp[ch], t0, + rate, + scale_factor); + } + + if (num_channels > 1) { + LVAL array = newvector(num_channels); + for(ch=0; ch<num_channels; ch++) + setelement(array, ch, cvsound(snd[ch])); + + setvalue(xlenter("S"), array); + } + else { + LVAL s = cvsound(snd[0]); + + setvalue(xlenter("S"), s); + } +} + +LOCAL int nyx_is_labels(LVAL expr) +{ + /* make sure that we have a list whose first element is a + list of the form (time "label") */ + + LVAL label; + LVAL first; + LVAL second; + LVAL third; + + if (expr == NULL) { + return 0; + } + + while (expr != NULL) { + if (!consp(expr)) + return 0; + + label = car(expr); + + if (!consp(label)) + return 0; + + first = car(label); + if (!(floatp(first) || fixp(first))) + return 0; + + if (!consp(cdr(label))) + return 0; + + second = car(cdr(label)); + + if (floatp(second) || fixp(second)) { + if (!consp(cdr(cdr(label)))) + return 0; + third = car(cdr(cdr(label))); + if (!(stringp(third))) + return 0; + } + else + if (!(stringp(second))) + return 0; + + expr = cdr(expr); + } + + return 1; +} + +nyx_rval nyx_get_type(LVAL expr) +{ + if (nyx_result_type != nyx_error) { + return nyx_result_type; + } + + nyx_result_type = nyx_error; + + if (expr==NULL) { + return nyx_result_type; + } + + switch(ntype(expr)) + { + case FIXNUM: + nyx_result_type = nyx_int; + break; + + case FLONUM: + nyx_result_type = nyx_double; + break; + + case STRING: + nyx_result_type = nyx_string; + break; + + case VECTOR: + { + /* make sure it's a vector of sounds */ + int i; + nyx_result_type = nyx_audio; + for(i=0; i<getsize(expr); i++) { + if (!soundp(getelement(expr, i))) { + nyx_result_type = nyx_error; + break; + } + } + } + break; + + case CONS: + { + /* see if it's a list of time/string pairs representing a + label track */ + if (nyx_is_labels(expr)) + nyx_result_type = nyx_labels; + } + break; + + case EXTERN: + { + if (soundp(expr)) + nyx_result_type = nyx_audio; + } + break; + } /* switch */ + + return nyx_result_type; +} + +nyx_rval nyx_eval_expression(const char *expr_string) +{ + LVAL expr = NULL; + +#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS + printf("\nnyx_eval_expression before\n"); + xmem(); +#endif + + nyx_expr_string = expr_string; + nyx_expr_len = strlen(nyx_expr_string); + nyx_expr_pos = 0; + + nyx_result = NULL; + nyx_result_type = nyx_error; + + xlprot1(expr); + + /* Setup a new context */ + xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true); + + /* setup the error return */ + if (setjmp(nyx_cntxt.c_jmpbuf)) { + // If the script is cancelled or some other condition occurs that causes + // the script to exit and return to this level, then we don't need to + // restore the previous context. + goto finish; + } + + while(nyx_expr_pos < nyx_expr_len) { + expr = NULL; + + /* read an expression */ + if (!xlread(getvalue(s_stdin), &expr, FALSE)) + break; + + #if 0 + /* save the input expression (so the user can refer to it + as +, ++, or +++) */ + xlrdsave(expr); + #endif + + /* evaluate the expression */ + nyx_result = xleval(expr); + } + + xlflush(); + + xltoplevel(); + + finish: + + xlpop(); /* unprotect expr */ + +#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS + printf("\nnyx_eval_expression after\n"); + xmem(); +#endif + + return nyx_get_type(nyx_result); +} + +int nyx_get_audio_num_channels() +{ + if (nyx_get_type(nyx_result) != nyx_audio) + return 0; + + if (vectorp(nyx_result)) + return getsize(nyx_result); + else + return 1; +} + +int nyx_get_audio(nyx_audio_callback callback, void *userdata) +{ + sample_block_type block; + sound_type snd; + sound_type *snds = NULL; + float *buffer = NULL; + long bufferlen = 0; + long *totals = NULL; + long *lens = NULL; + long cnt; + int result = 0; + int num_channels; + int ch, i; + int success = FALSE; + + if (nyx_get_type(nyx_result) != nyx_audio) + return success; + +#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS + printf("\nnyx_get_audio before\n"); + xmem(); +#endif + + num_channels = nyx_get_audio_num_channels(); + + snds = (sound_type *)malloc(num_channels * sizeof(sound_type)); + if (snds == NULL) { + goto finish; + } + + totals = (long *)malloc(num_channels * sizeof(long)); + if (totals == NULL) { + goto finish; + } + + lens = (long *)malloc(num_channels * sizeof(long)); + if (lens == NULL) { + goto finish; + } + + /* Setup a new context */ + xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true); + + /* setup the error return */ + if (setjmp(nyx_cntxt.c_jmpbuf)) { + // If the script is cancelled or some other condition occurs that causes + // the script to exit and return to this level, then we don't need to + // restore the previous context. + goto finish; + } + + for(ch=0; ch<num_channels; ch++) { + if (num_channels == 1) + snd = getsound(nyx_result); + else + snd = getsound(getelement(nyx_result, ch)); + snds[ch] = snd; + totals[ch] = 0; + lens[ch] = snd_length(snd, snd->stop); + } + + while(result==0) { + for(ch=0; ch<num_channels; ch++) { + snd = snds[ch]; + cnt = 0; + block = snd->get_next(snd, &cnt); + if (block == zero_block || cnt == 0) { + result = -1; + break; + } + + /* copy the data to a temporary buffer and scale it + by the appropriate scale factor */ + + if (cnt > bufferlen) { + if (buffer) + free(buffer); + + buffer = (float *)malloc(cnt * sizeof(float)); + if (buffer == NULL) { + goto finish; + } + + bufferlen = cnt; + } + + memcpy(buffer, block->samples, cnt * sizeof(float)); + + for(i=0; i<cnt; i++) + buffer[i] *= snd->scale; + + result = callback(buffer, ch, + totals[ch], cnt, lens[ch], userdata); + + if (result != 0) { + // The user canceled or some other error occurred, so we use + // xlsignal() to jump back to our error handler. + xlsignal(NULL, NULL); + // never get here. + } + + totals[ch] += cnt; + } + } + + success = TRUE; + + xltoplevel(); + + finish: + + gc(); + + if (buffer) { + free(buffer); + } + + if (lens) { + free(lens); + } + + if (totals) { + free(totals); + } + + if (snds) { + free(snds); + } + +#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS + printf("\nnyx_get_audio after\n"); + xmem(); +#endif + + return success; +} + +int nyx_get_int() +{ + if (nyx_get_type(nyx_result) != nyx_int) + return -1; + + return getfixnum(nyx_result); +} + +double nyx_get_double() +{ + if (nyx_get_type(nyx_result) != nyx_double) + return -1.0; + + return getflonum(nyx_result); +} + +const char *nyx_get_string() +{ + if (nyx_get_type(nyx_result) != nyx_string) + return NULL; + + return (const char *)getstring(nyx_result); +} + +unsigned int nyx_get_num_labels() +{ + LVAL s = nyx_result; + int count = 0; + + if (nyx_get_type(nyx_result) != nyx_labels) + return 0; + + while(s) { + count++; + s = cdr(s); + } + + return count; +} + +void nyx_get_label(unsigned int index, + double *start_time, + double *end_time, + const char **label) +{ + LVAL s = nyx_result; + LVAL label_expr; + LVAL t0_expr; + LVAL t1_expr; + LVAL str_expr; + + if (nyx_get_type(nyx_result) != nyx_labels) + return; + + while(index) { + index--; + s = cdr(s); + if (s == NULL) { + // index was larger than number of labels + return; + } + } + + /* We either have (t0 "label") or (t0 t1 "label") */ + + label_expr = car(s); + t0_expr = car(label_expr); + t1_expr = car(cdr(label_expr)); + if (stringp(t1_expr)) { + str_expr = t1_expr; + t1_expr = t0_expr; + } + else + str_expr = car(cdr(cdr(label_expr))); + + if (floatp(t0_expr)) + *start_time = getflonum(t0_expr); + else if (fixp(t0_expr)) + *start_time = (double)getfixnum(t0_expr); + + if (floatp(t1_expr)) + *end_time = getflonum(t1_expr); + else if (fixp(t1_expr)) + *end_time = (double)getfixnum(t1_expr); + + *label = (const char *)getstring(str_expr); +} + +const char *nyx_get_error_str() +{ + return NULL; +} + +void nyx_set_os_callback(nyx_os_callback callback, void *userdata) +{ + nyx_os_cb = callback; + nyx_os_ud = userdata; +} + +void nyx_stop() +{ + xlflush(); + xltoplevel(); +} + +void nyx_break() +{ + xlflush(); + xlbreak("BREAK", s_unbound); +} + +void nyx_continue() +{ + xlflush(); + xlcontinue(); +} + +int ostgetc() +{ + if (nyx_expr_pos < nyx_expr_len) { + fflush(stdout); + return (nyx_expr_string[nyx_expr_pos++]); + } + else if (nyx_expr_pos == nyx_expr_len) { + /* Add whitespace at the end so that the parser + knows that this is the end of the expression */ + nyx_expr_pos++; + return '\n'; + } + else + return EOF; +} + +/* osinit - initialize */ +void osinit(char *banner) +{ +} + +/* osfinish - clean up before returning to the operating system */ +void osfinish(void) +{ +} + +/* oserror - print an error message */ +void oserror(char *msg) +{ + printf("nyx error: %s\n", msg); +} + +long osrand(long n) +{ + return (((int) rand()) % n); +} + +/* cd .. +open - open an ascii file */ +FILE *osaopen(name,mode) char *name,*mode; +{ + FILE *fp; + fp = fopen(name,mode); + return fp; +} + +/* osbopen - open a binary file */ +FILE *osbopen(char *name, char *mode) +{ + char bmode[10]; + FILE *fp; + + strncpy(bmode, mode, 8); + strcat(bmode,"b"); + fp = fopen(name,bmode); + return fp; +} + +/* osclose - close a file */ +int osclose(FILE *fp) +{ + return (fclose(fp)); +} + +/* osagetc - get a character from an ascii file */ +int osagetc(FILE *fp) +{ + return (getc(fp)); +} + +/* osaputc - put a character to an ascii file */ +int osaputc(int ch, FILE *fp) +{ + return (putc(ch,fp)); +} + +/* osoutflush - flush output to a file */ +void osoutflush(FILE *fp) { fflush(fp); } + +extern int dbgflg; + +/* osbgetc - get a character from a binary file */ +/* int osbgetc(fp) FILE *fp; {return (getc(fp));} */ +#ifndef WIN32 // duplicated in winfun.c, per James Crook, 7/4/2003 + int osbgetc(FILE *fp) + { + return (getc(fp)); + } +#endif + +/* osbputc - put a character to a binary file */ +int osbputc(int ch, FILE *fp) +{ + return (putc(ch,fp)); +} + +/* ostputc - put a character to the terminal */ +void ostputc(int ch) +{ + oscheck(); /* check for control characters */ + + if (nyx_output_cb) + nyx_output_cb(ch, nyx_output_ud); + else + putchar(((char) ch)); +} + +/* ostoutflush - flush output buffer */ +void ostoutflush() +{ + if (!nyx_output_cb) + fflush(stdout); +} + +/* osflush - flush the terminal input buffer */ +void osflush(void) +{ +} + +/* oscheck - check for control characters during execution */ +void oscheck(void) +{ + if (nyx_os_cb) { + nyx_os_cb(nyx_os_ud); + } + /* if they hit control-c: + xflush(); xltoplevel(); return; + */ +} + +/* xsystem - execute a system command */ +#ifndef WIN32 // duplicated in winfun.c, per James Crook, 7/4/2003 +LVAL xsystem() +{ + if (moreargs()) { + unsigned char *cmd; + cmd = (unsigned char *)getstring(xlgastring()); + fprintf(stderr, "Will not execute system command: %s\n", cmd); + } + return s_true; +} +#endif + +#ifndef WIN32 +/* xsetdir -- set current directory of the process */ +LVAL xsetdir() +{ + char *dir = (char *)getstring(xlgastring()); + int result; + LVAL cwd = NULL; + xllastarg(); + result = chdir(dir); + if (result) { + perror("SETDIR"); + } + dir = getcwd(NULL, 1000); + if (dir) { + cwd = cvstring(dir); + free(dir); + } + return cwd; +} +#endif + +/* xgetkey - get a key from the keyboard */ +#ifndef WIN32 // duplicated in winfun.c, per James Crook, 7/4/2003 + LVAL xgetkey() {xllastarg(); return (cvfixnum((FIXTYPE)getchar()));} +#endif + +/* ossymbols - enter os specific symbols */ +#ifndef WIN32 // duplicated in winfun.c, per James Crook, 7/4/2003 + void ossymbols(void) {} +#endif + +/* xsetupconsole -- used to configure window in Win32 version */ +#ifndef WIN32 // duplicated in winfun.c, per James Crook, 7/4/2003 + LVAL xsetupconsole() { return NULL; } +#endif + +const char os_pathchar = '/'; +const char os_sepchar = ':'; + +/* control-C handling */ +void ctcinit() {} + +/* xechoenabled -- set/clear echo_enabled flag (unix only) */ +LVAL xechoenabled() { return NULL; } + +/* osdir_list_start -- open a directory listing */ +int osdir_list_start(char *path) { return FALSE; } + +/* osdir_list_next -- read the next entry from a directory */ +char *osdir_list_next() { return NULL; } + +/* osdir_list_finish -- close an open directory */ +void osdir_list_finish() { return; } + +#ifndef WIN32 +/* xget_temp_path -- get a path to create temp files */ +LVAL xget_temp_path() +{ + char *tmp = getenv("TMPDIR"); + if (!tmp || !*tmp) { + tmp = getenv("TMP"); + if (!tmp || !*tmp) { + tmp = "/tmp/"; + } + } + return cvstring(tmp); +} +#endif + +#ifndef WIN32 +/* xget_user -- get a string identifying the user, for use in file names */ +LVAL xget_user() +{ + char *user = getenv("USER"); + if (!user || !*user) { + user = getenv("USERNAME"); + if (!user || !*user) { + errputstr("Warning: could not get user ID, using 'nyquist'\n"); + user = "nyquist"; + } + } + return cvstring(user); +} +#endif diff --git a/nyqsrc/nyx.h b/nyqsrc/nyx.h new file mode 100644 index 0000000..8dccb99 --- /dev/null +++ b/nyqsrc/nyx.h @@ -0,0 +1,66 @@ +/********************************************************************** + + nyx.h + + Nyx: A very simple external interface to Nyquist + + Dominic Mazzoni + +**********************************************************************/ + +#ifndef __NYX__ +#define __NYX__ + +#ifdef __cplusplus +extern "C" +{ +#endif /* __cplusplus */ + + typedef enum { + nyx_error, + nyx_audio, + nyx_int, + nyx_double, + nyx_string, + nyx_labels + } nyx_rval; + + void nyx_init(); + void nyx_cleanup(); + + /* should return return 0 for success, -1 for error */ + typedef int (*nyx_audio_callback)(float *buffer, + int channel, + long start, long len, + void *userdata); + + void nyx_set_input_audio(nyx_audio_callback callback, + void *userdata, + int num_channels, + long len, double rate); + + nyx_rval nyx_eval_expression(const char *expr); + + int nyx_get_audio_num_channels(); + void nyx_get_audio(nyx_audio_callback callback, + void *userdata); + + int nyx_get_int(); + double nyx_get_double(); + const char *nyx_get_string(); + + int nyx_get_num_labels(); + void nyx_get_label(int index, + double *time, + const char **label); + + const char *nyx_get_error_str(); + + + +#ifdef __cplusplus +} +#endif /* __cplusplus */ + +#endif /* __NYX__ */ + diff --git a/nyqsrc/oldyin.c b/nyqsrc/oldyin.c new file mode 100644 index 0000000..43387b1 --- /dev/null +++ b/nyqsrc/oldyin.c @@ -0,0 +1,466 @@ +/* yin.c -- partial implementation of the YIN algorithm, with some + * fixes by DM. This code should be replaced with the fall 2002 + * intro to computer music implementation project. + */ + +#include "stdio.h" +#ifdef UNIX +#include "sys/file.h" +#endif +#ifndef mips +#include "stdlib.h" +#endif +#include "snd.h" +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "yin.h" + +void yin_free(); + +/* for multiple channel results, one susp is shared by all sounds */ +/* the susp in turn must point back to all sound list tails */ + +typedef struct yin_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + long blocksize; + long stepsize; + sample_type *block; + float *temp; + sample_type *fillptr; + sample_type *endptr; + snd_list_type chan[2]; /* array of back pointers */ + long cnt; /* how many sample frames to read */ + long m; + long middle; +} yin_susp_node, *yin_susp_type; + + +// Uses cubic interpolation to return the value of x such +// that the function defined by f(0), f(1), f(2), and f(3) +// is maximized. +// +float CubicMaximize(float y0, float y1, float y2, float y3) +{ + // Find coefficients of cubic + + float a, b, c, d; + float da, db, dc; + float discriminant; + float x1, x2; + float dda, ddb; + + a = (float) (y0/-6.0 + y1/2.0 - y2/2.0 + y3/6.0); + b = (float) (y0 - 5.0*y1/2.0 + 2.0*y2 - y3/2.0); + c = (float) (-11.0*y0/6.0 + 3.0*y1 - 3.0*y2/2.0 + y3/3.0); + d = y0; + + // Take derivative + + da = 3*a; + db = 2*b; + dc = c; + + // Find zeroes of derivative using quadratic equation + + discriminant = db*db - 4*da*dc; + if (discriminant < 0.0) + return -1.0; // error + + x1 = (float) ((-db + sqrt(discriminant)) / (2 * da)); + x2 = (float) ((-db - sqrt(discriminant)) / (2 * da)); + + // The one which corresponds to a local _maximum_ in the + // cubic is the one we want - the one with a negative + // second derivative + + dda = 2*da; + ddb = db; + + if (dda*x1 + ddb < 0) + return x1; + else + return x2; +} + + +void yin_compute(yin_susp_type susp, float *pitch, float *harmonicity) +{ + float *samples = susp->block; + int middle = susp->middle; + /* int n = middle * 2; */ + int m = susp->m; + float threshold = 0.9F; + float *results = susp->temp; + + /* samples is a buffer of samples */ + /* n is the number of samples, equals twice longest period, must be even */ + /* m is the shortest period in samples */ + /* results is an array of size n/2 - m + 1, the number of different lags */ + + /* work from the middle of the buffer: */ + int i, j; /* loop counters */ + /* how many different lags do we compute? */ + /* int iterations = middle + 1 - m; */ + float left_energy = 0; + float right_energy = 0; + /* for each window, we keep the energy so we can compute the next one */ + /* incrementally. First, we need to compute the energies for lag m-1: */ + *pitch = 0; + for (i = 0; i < m - 1; i++) { + float left = samples[middle - 1 - i]; + float right = samples[middle + i]; + left_energy += left * left; + right_energy += right * right; + } + for (i = m; i <= middle; i++) { + /* i is the lag and the length of the window */ + /* compute the energy for left and right */ + float left, right, energy, a; + float harmonic; + left = samples[middle - i]; + left_energy += left * left; + right = samples[middle - 1 + i]; + right_energy += right * right; + /* compute the autocorrelation */ + a = 0; + for (j = 0; j < i; j++) { + a += samples[middle - i + j] * samples[middle + j]; + } + energy = left_energy + right_energy; + harmonic = (2 * a) / energy; + results[i - m] = harmonic; + } + for (i = m; i <= middle; i++) { + if (results[i - m] > threshold) { + float f_i = (i - 1) + + CubicMaximize(results[i - m - 1], results[i - m], + results[i - m + 1], results[i - m + 2]); + if (f_i < i - m - 1 || f_i > i - m + 2) f_i = (float) i; + *pitch = (float) hz_to_step((float) susp->susp.sr / f_i); + *harmonicity = results[i - m]; + break; + } + } +} + + +/* yin_fetch - compute F0 and harmonicity using YIN approach. */ +/* + * The pitch (F0) is determined by finding two periods whose + * inner product accounts for almost all of the energy. Let X and Y + * be adjacent vectors of length N in the sample stream. Then, + * if 2X*Y > threshold * (X*X + Y*Y) + * then the period is given by N + * In the algorithm, we compute different sizes until we find a + * peak above threshold. Then, we use cubic interpolation to get + * a precise value. If no peak above threshold is found, we return + * the first peak. The second channel returns the value 2X*Y/(X*X+Y*Y) + * which is refered to as the "harmonicity" -- the amount of energy + * accounted for by periodicity. + * + * Low sample rates are advised because of the high cost of computing + * inner products (fast autocorrelation is not used). + * + * The result is a 2-channel signal running at the requested rate. + * The first channel is the estimated pitch, and the second channel + * is the harmonicity. + * + * This code is adopted from multiread, currently the only other + * multichannel suspension in Nyquist. Comments from multiread include: + * The susp is shared by all channels. The susp has backpointers + * to the tail-most snd_list node of each channel, and it is by + * extending the list at these nodes that sounds are read in. + * To avoid a circularity, the reference counts on snd_list nodes + * do not include the backpointers from this susp. When a snd_list + * node refcount goes to zero, the yin susp's free routine + * is called. This must scan the backpointers to find the node that + * has a zero refcount (the free routine is called before the node + * is deallocated, so this is safe). The backpointer is then set + * to NULL. When all backpointers are NULL, the susp itself is + * deallocated, because it can only be referenced through the + * snd_list nodes to which there are backpointers. + */ +void yin_fetch(yin_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + int togo = 0; + int n; + sample_block_type f0; + sample_block_values_type f0_ptr = NULL; + sample_block_type harmonicity; + sample_block_values_type harmonicity_ptr = NULL; + + register sample_block_values_type s_ptr_reg; + register sample_type *fillptr_reg; + register sample_type *endptr_reg = susp->endptr; + + if (susp->chan[0]) { + falloc_sample_block(f0, "yin_fetch"); + f0_ptr = f0->samples; + /* Since susp->chan[i] exists, we want to append a block of samples. + * The block, out, has been allocated. Before we insert the block, + * we must figure out whether to insert a new snd_list_type node for + * the block. Recall that before SND_get_next is called, the last + * snd_list_type in the list will have a null block pointer, and the + * snd_list_type's susp field points to the suspension (in this case, + * susp). When SND_get_next (in sound.c) is called, it appends a new + * snd_list_type and points the previous one to internal_zero_block + * before calling this fetch routine. On the other hand, since + * SND_get_next is only going to be called on one of the channels, the + * other channels will not have had a snd_list_type appended. + * SND_get_next does not tell us directly which channel it wants (it + * doesn't know), but we can test by looking for a non-null block in the + * snd_list_type pointed to by our back-pointers in susp->chan[]. If + * the block is null, the channel was untouched by SND_get_next, and + * we should append a snd_list_type. If it is non-null, then it + * points to internal_zero_block (the block inserted by SND_get_next) + * and a new snd_list_type has already been appended. + */ + /* Before proceeding, it may be that garbage collection ran when we + * allocated out, so check again to see if susp->chan[j] is Null: + */ + if (!susp->chan[0]) { + ffree_sample_block(f0, "yin_fetch"); + f0 = NULL; /* make sure we don't free it again */ + f0_ptr = NULL; /* make sure we don't output f0 samples */ + } else if (!susp->chan[0]->block) { + snd_list_type snd_list = snd_list_create((snd_susp_type) susp); + /* Now we have a snd_list to append to the channel, but a very + * interesting thing can happen here. snd_list_create, which + * we just called, MAY have invoked the garbage collector, and + * the GC MAY have freed all references to this channel, in which + * case yin_free(susp) will have been called, and susp->chan[0] + * will now be NULL! + */ + if (!susp->chan[0]) { + ffree_snd_list(snd_list, "yin_fetch"); + } else { + susp->chan[0]->u.next = snd_list; + } + } + /* see the note above: we don't know if susp->chan still exists */ + /* Note: We DO know that susp still exists because even if we lost + * some channels in a GC, someone is still calling SND_get_next on + * some channel. I suppose that there might be some very pathological + * code that could free a global reference to a sound that is in the + * midst of being computed, perhaps by doing something bizarre in the + * closure that snd_seq activates at the logical stop time of its first + * sound, but I haven't thought that one through. + */ + if (susp->chan[0]) { + susp->chan[0]->block = f0; + /* check some assertions */ + if (susp->chan[0]->u.next->u.susp != (snd_susp_type) susp) { + nyquist_printf("didn't find susp at end of list for chan 0\n"); + } + } else if (f0) { /* we allocated f0, but don't need it anymore due to GC */ + ffree_sample_block(f0, "yin_fetch"); + f0_ptr = NULL; + } + } + + /* Now, repeat for channel 1 (comments omitted) */ + if (susp->chan[1]) { + falloc_sample_block(harmonicity, "yin_fetch"); + harmonicity_ptr = harmonicity->samples; + if (!susp->chan[1]) { + ffree_sample_block(harmonicity, "yin_fetch"); + harmonicity = NULL; /* make sure we don't free it again */ + harmonicity_ptr = NULL; + } else if (!susp->chan[1]->block) { + snd_list_type snd_list = snd_list_create((snd_susp_type) susp); + if (!susp->chan[1]) { + ffree_snd_list(snd_list, "yin_fetch"); + } else { + susp->chan[1]->u.next = snd_list; + } + } + if (susp->chan[1]) { + susp->chan[1]->block = harmonicity; + if (susp->chan[1]->u.next->u.susp != (snd_susp_type) susp) { + nyquist_printf("didn't find susp at end of list for chan 1\n"); + } + } else if (harmonicity) { /* we allocated harmonicity, but don't need it anymore due to GC */ + ffree_sample_block(harmonicity, "yin_fetch"); + harmonicity_ptr = NULL; + } + } + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first, compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block */ + togo = (max_sample_block_len - cnt) * susp->stepsize; + + /* don't run past the s input sample block */ + susp_check_term_log_samples(s, s_ptr, s_cnt); + togo = min(togo, susp->s_cnt); + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo/susp->stepsize) { + togo = (susp->terminate_cnt - (susp->susp.current + cnt)) * susp->stepsize; + if (togo == 0) break; + } + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + /* break if to_stop = 0 (we're at the logical stop) + * AND cnt > 0 (we're not at the beginning of the output block) + */ + if (to_stop < togo/susp->stepsize) { + if (to_stop == 0) { + if (cnt) { + togo = 0; + break; + } else /* keep togo as is: since cnt == 0, we can set + * the logical stop flag on this output block + */ + susp->logically_stopped = true; + } else /* limit togo so we can start a new block a the LST */ + togo = to_stop * susp->stepsize; + } + } + n = togo; + s_ptr_reg = susp->s_ptr; + fillptr_reg = susp->fillptr; + if (n) do { /* the inner sample computation loop */ + *fillptr_reg++ = *s_ptr_reg++; + if (fillptr_reg >= endptr_reg) { + float f0; + float harmonicity; + yin_compute(susp, &f0, &harmonicity); + if (f0_ptr) *f0_ptr++ = f0; + if (harmonicity_ptr) *harmonicity_ptr++ = harmonicity; + cnt++; + fillptr_reg -= susp->stepsize; + } + } while (--n); /* inner loop */ + + /* using s_ptr_reg is a bad idea on RS/6000: */ + susp->s_ptr += togo; + susp->fillptr = fillptr_reg; + susp_took(s_cnt, togo); + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } + + /* test for logical stop */ + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* yin_fetch */ + + +void yin_mark(yin_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void yin_free(yin_susp_type susp) +{ + int j; + boolean active = false; +/* stdputstr("yin_free: "); */ + + for (j = 0; j < 2; j++) { + if (susp->chan[j]) { + if (susp->chan[j]->refcnt) active = true; + else { + susp->chan[j] = NULL; + /* nyquist_printf("deactivating channel %d\n", j); */ + } + } + } + if (!active) { +/* stdputstr("all channels freed, freeing susp now\n"); */ + ffree_generic(susp, sizeof(yin_susp_node), "yin_free"); + sound_unref(susp->s); + free(susp->block); + free(susp->temp); + } +} + + +void yin_print_tree(yin_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +LVAL snd_make_yin(sound_type s, double low_step, double high_step, long stepsize) +{ + LVAL result; + int j; + register yin_susp_type susp; + rate_type sr = s->sr; + time_type t0 = s->t0; + + falloc_generic(susp, yin_susp_node, "snd_make_yin"); + susp->susp.fetch = yin_fetch; + susp->terminate_cnt = UNKNOWN; + + /* initialize susp state */ + susp->susp.free = yin_free; + susp->susp.sr = sr / stepsize; + susp->susp.t0 = t0; + susp->susp.mark = yin_mark; + susp->susp.print_tree = yin_print_tree; + susp->susp.name = "yin"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s); + susp->susp.current = 0; + susp->s = s; + susp->s_cnt = 0; + susp->m = (long) (sr / step_to_hz(high_step)); + if (susp->m < 2) susp->m = 2; + /* add 1 to make sure we round up */ + susp->middle = (long) (sr / step_to_hz(low_step)) + 1; + susp->blocksize = susp->middle * 2; + susp->stepsize = stepsize; + /* blocksize must be at least step size to implement stepping */ + if (susp->stepsize > susp->blocksize) susp->blocksize = susp->stepsize; + susp->block = (sample_type *) malloc(susp->blocksize * sizeof(sample_type)); + susp->temp = (float *) malloc((susp->middle - susp->m + 1) * sizeof(float)); + susp->fillptr = susp->block; + susp->endptr = susp->block + susp->blocksize; + + xlsave1(result); + + result = newvector(2); /* create array for F0 and harmonicity */ + /* create sounds to return */ + for (j = 0; j < 2; j++) { + sound_type snd = sound_create((snd_susp_type)susp, + susp->susp.t0, susp->susp.sr, 1.0); + LVAL snd_lval = cvsound(snd); +/* nyquist_printf("yin_create: sound %d is %x, LVAL %x\n", j, snd, snd_lval); */ + setelement(result, j, snd_lval); + susp->chan[j] = snd->list; + } + xlpop(); + return result; +} + + +LVAL snd_yin(sound_type s, double low_step, double high_step, long stepsize) +{ + sound_type s_copy = sound_copy(s); + return snd_make_yin(s_copy, low_step, high_step, stepsize); +} diff --git a/nyqsrc/oldyin.h b/nyqsrc/oldyin.h new file mode 100644 index 0000000..656aa81 --- /dev/null +++ b/nyqsrc/oldyin.h @@ -0,0 +1,6 @@ +/* yin.h -- Nyquist code for F0 estimation using YIN approach */ + + +LVAL snd_yin(sound_type s, double low_step, double high_step, long stepsize); +/* LISP: (SND-YIN SOUND ANYNUM ANYNUM FIXNUM) */ + diff --git a/nyqsrc/phasevocoder.c b/nyqsrc/phasevocoder.c new file mode 100644 index 0000000..d446095 --- /dev/null +++ b/nyqsrc/phasevocoder.c @@ -0,0 +1,102 @@ +/* phasevocoder.c -- this is a stub showing how you might hook a + phase vocoder into Nyquist using pvshell + */ + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "pvshell.h" + +#include "phasevocoder.h" + +/* use the state[] info for sample interpolation */ +#define X_VALUE state[0] /* a parameter value */ +#define F_COUNT state[1] /* counts samples of f */ +#define G_COUNT state[2] /* counts samples of g */ +#define G_PREV state[3] /* previous value from g */ +#define G_NEXT state[4] /* next (current?) value from g */ +/* invariant: G_NEXT is the G_COUNT'th sample of g */ + +/* pv_fetch -- this is an example, but it doesn't really do + * phase vocoding. Instead, it will just multiply f, g, and x + * + * To make things a bit more interesting, we will assume g has + * an arbitrary sample rate with respect to f, and will interpolate. + * + */ +long pv_fetch(pvshell_type susp, + sample_block_values_type out, long *n) +{ + int i; + for (i = 0; i < *n; i++) { + long new_flags; + sample_type f; + double g; + /* NOTE: in DSP terms, this is poor code because of the + * division operations -- it could be made faster + */ + /* To get a value from g, first compute the time */ + double f_time = susp->F_COUNT / susp->f->sr; + /* Now compute g count that is past the time */ + double g_count = f_time * susp->g->sr; + while (susp->G_COUNT < g_count) { + PVSHELL_TEST_G(susp); /* prepare to get a sample */ + /* ignore flags from g -- we could, if we wanted, + * terminate when either f or g terminated, etc. + */ + susp->G_PREV = susp->G_NEXT; + susp->G_NEXT = PVSHELL_FETCH_G(susp); + susp->G_COUNT++; + } + /* now interpolate to get the value of g at f_time */ + g = susp->G_PREV + (susp->G_NEXT - susp->G_PREV) * + (g_count - (susp->G_COUNT - 1)); + new_flags = PVSHELL_TEST_F(susp); + susp->flags |= new_flags; + if (new_flags) break; + f = PVSHELL_FETCH_F(susp); + susp->F_COUNT++; /* count how many samples we have taken */ + + /* now we have f, g, x */ + *out++ = f * g * susp->X_VALUE; + } + /* i is the number of samples we acutally computed */ + *n = i; + /* if we computed samples, we want to return them before + * returning flags that say we're done or stopped + */ + return (i ? 0 : susp->flags); +} + + +sound_type snd_phasevocoder(sound_type f, sound_type g, double x) +{ + /* we're using 5 doubles of state. The first is a parameter, + * and the rest are initialized to zero except for state[2], + * aka G_COUNT. This is the number of samples we have read + * from G. Since we're interpolating we need a one-sample + * lookahead, and initializing the count to -1 causes an + * extra fetch and hence 1-sample lookahead. This state is copied + * into the pvshell structure, so we don't need to allocate + * a vector on the heap. + */ + double state[5] = {0, 0, -1, 0, 0}; + state[0] = x; + /* If f and g do not start at the same time, we should really + * should do something about it, but we'll just throw an error. + * Be careful to allow small differences (within one sample). + */ + if (fabs(f->t0 - g->t0) * f->sr > 0.5) { + xlfail("phasevocoder inputs must start at the same time"); + } + /* output the same sample rate and start time as f */ + return snd_make_pvshell("snd_phasevocoder", f->sr, f->t0, + &pv_fetch, f, g, + state, sizeof(state) / sizeof(state[0])); +} diff --git a/nyqsrc/phasevocoder.h b/nyqsrc/phasevocoder.h new file mode 100644 index 0000000..8d941b3 --- /dev/null +++ b/nyqsrc/phasevocoder.h @@ -0,0 +1,6 @@ +/* phasevocoder.h -- this is a stub showing how you might hook a + phase vocoder into Nyquist using pvshell + */ + +sound_type snd_phasevocoder(sound_type f, sound_type g, double x); + /* LISP: (snd-phasevocoder SOUND SOUND ANYNUM) */ diff --git a/nyqsrc/probe.c b/nyqsrc/probe.c new file mode 100644 index 0000000..9a04b4a --- /dev/null +++ b/nyqsrc/probe.c @@ -0,0 +1,38 @@ +/* probe.c -- used to test resampling */ + +#include "stdio.h" +#include "string.h" +#include "xlisp.h" + +static FILE* probefile = NULL; +static long line_num = 0; + +void probe_init(int readflag) +{ + line_num = 0; + probefile = fopen("probe.log", (readflag ? "r" : "w")); +} + + +double probe(char *s, double x) +{ + fprintf(probefile, "%s %g\n", s, x); + return x; +} + + +double probe2(char *s, double x) +{ + char buf1[100], buf2[100]; + sprintf(buf1, "%s %g\n", s, x); + fgets(buf2, 100, probefile); + line_num++; + if (strcmp(buf1, buf2)) { + nyquist_printf("probe2: difference at line %ld: \n", line_num); + nyquist_printf("correct: %s", buf2); + nyquist_printf("actual: %s", buf1); + abort(); + } + return x; +} + diff --git a/nyqsrc/probe.h b/nyqsrc/probe.h new file mode 100644 index 0000000..ca727d6 --- /dev/null +++ b/nyqsrc/probe.h @@ -0,0 +1,6 @@ +/* probe.h -- used to test resampling */ + +void probe_init(int readflag); +double probe(char *s, double x); +double probe2(char *s, double x); + diff --git a/nyqsrc/pvshell.c b/nyqsrc/pvshell.c new file mode 100644 index 0000000..e281649 --- /dev/null +++ b/nyqsrc/pvshell.c @@ -0,0 +1,202 @@ +// pvshell.c -- This is a skeleton for a Nyquist primitive that +// returns a sound. The sound is obtained by calling a function +// with a request consisting of a location to put samples and +// a count of how many samples are needed. The function returns +// the actual number of samples computed and flags indicating +// if the signal has reached the logical stop or termination. +// In addition, there are interfaces for extracting samples +// from input sounds. +// This code is designed for a time-stretching phase vocoder, +// but could be used for other purposes. It is derived from +// compose.c, which might have been implmented with this +// skeleton had we started out with this abstraction. + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "pvshell.h" +#include "assert.h" + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +void pvshell_free(); + + +typedef struct pvshell_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + boolean started; + + pvshell_node pvshell; +} pvshell_susp_node, *pvshell_susp_type; + + +/* pvshell_test_f -- get next sample block and check flags + * + * Only call this from PVSHELL_TEST_F macro + */ +long pvshell_test_f(pvshell_type susp) +{ + long flags = 0; + susp_get_samples(f, f_ptr, f_cnt); /* warning: macro references susp */ + if (susp->f->logical_stop_cnt == susp->f->current - susp->f_cnt) { + flags |= PVSHELL_FLAG_LOGICAL_STOP; + } + if (susp->f_ptr == zero_block->samples) { + flags |= PVSHELL_FLAG_TERMINATE; + } + return flags; +} + + +/* pvshell_test_g -- get next sample block and check flags + * + * Only call this from PVSHELL_TEST_G macro + */ +long pvshell_test_g(pvshell_type susp) +{ + long flags = 0; + susp_get_samples(g, g_ptr, g_cnt); /* warning: macro references susp */ + if (susp->g->logical_stop_cnt == susp->g->current - susp->g_cnt) { + flags |= PVSHELL_FLAG_LOGICAL_STOP; + } + if (susp->g_ptr == zero_block->samples) { + flags |= PVSHELL_FLAG_TERMINATE; + } + return flags; +} + + +/* pvshell_fetch -- computes h(f, g, x, y) where f and g are + * sounds, x and y are doubles, and h implemented via a function + * pointer. This could certainly be generalized further, but + * maybe we should take this one step at a time. +/**/ +void pvshell_fetch(register pvshell_susp_type susp, snd_list_type snd_list) +{ + long n, flags; + sample_block_type out; + sample_block_values_type out_ptr; + + falloc_sample_block(out, "pvshell_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* don't run past the f input sample block: */ + /* most fetch routines call susp_check_term_log_samples() here + * but we can't becasue susp_check_term_log_samples() assumes + * that output time progresses at the same rate as input time. + * Here, some time warping might be going on, so this doesn't work. + * It is up to the user to tell us when it is the logical stop + * time and the terminate time. + */ + /* don't run past terminate time */ + // if (susp->terminate_cnt != UNKNOWN && + // susp->terminate_cnt <= susp->susp.current + cnt + togo) { + // togo = susp->terminate_cnt - (susp->susp.current + cnt); + // if (togo == 0) break; + // } + /* don't run past logical stop time */ + // if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + // int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + // if (to_stop < togo && ((togo = to_stop) == 0)) break; + // } + n = max_sample_block_len; // ideally, compute a whole block of samples + + flags = (susp->pvshell.h)(&(susp->pvshell), out_ptr, &n); + + /* test for termination */ + if (flags & PVSHELL_FLAG_TERMINATE) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = n; + susp->susp.current += n; + } + /* test for logical stop */ + if (flags & PVSHELL_FLAG_LOGICAL_STOP || susp->logically_stopped) { + snd_list->logically_stopped = true; + susp->logically_stopped = true; + } +} /* pvshell_fetch */ + + +void pvshell_mark(pvshell_susp_type susp) +{ + sound_xlmark(susp->pvshell.f); + sound_xlmark(susp->pvshell.g); +} + + +void pvshell_free(pvshell_susp_type susp) +{ + /* note that f or g can be NULL */ + sound_unref(susp->pvshell.f); + sound_unref(susp->pvshell.g); + ffree_generic(susp, sizeof(pvshell_susp_node), "pvshell_free"); +} + + +void pvshell_print_tree(pvshell_susp_type susp, int n) +{ + indent(n); + stdputstr("f:"); + sound_print_tree_1(susp->pvshell.f, n); + + indent(n); + stdputstr("g:"); + sound_print_tree_1(susp->pvshell.g, n); +} + + +sound_type snd_make_pvshell(char *name, rate_type sr, time_type t0, + h_fn_type h, sound_type f, sound_type g, + double *state, long n) +{ + register pvshell_susp_type susp; + int i; + + falloc_generic(susp, pvshell_susp_node, "snd_make_pvshell"); + susp->susp.fetch = pvshell_fetch; + susp->terminate_cnt = UNKNOWN; + + /* initialize susp state */ + susp->susp.free = pvshell_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = pvshell_mark; + susp->susp.print_tree = pvshell_print_tree; + susp->susp.name = name; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + + /* copy the sound so that we have a private "reader" object */ + susp->pvshell.f = (f ? sound_copy(f) : f); + susp->pvshell.f_cnt = 0; + + susp->pvshell.g = (g ? sound_copy(g) : g); + susp->pvshell.g_cnt = 0; + + susp->pvshell.h = h; + + susp->pvshell.flags = 0; /* terminated and logically stopped flags -- these + are for the client of pvshell to use */ + + assert(n <= PVSHELL_STATE_MAX); + for (i = 0; i < n; i++) { + susp->pvshell.state[i] = state[i]; + } + + susp->started = false; + return sound_create((snd_susp_type)susp, t0, sr, 1.0); +} diff --git a/nyqsrc/pvshell.h b/nyqsrc/pvshell.h new file mode 100644 index 0000000..6e925fb --- /dev/null +++ b/nyqsrc/pvshell.h @@ -0,0 +1,90 @@ +/* pvshell.h -- a generic Nyquist primitive, esp. for phase vocoder */ + +/* how many doubles to provide for miscellaneous state info */ +#define PVSHELL_STATE_MAX 8 + +/* define some bits to return conditions */ +#define PVSHELL_FLAG_TERMINATE 4 +#define PVSHELL_FLAG_LOGICAL_STOP 8 + +/* this function is called to compute samples. It should compute n + * samples (floats == sample_type) and store them at out[i]. + * You can return less than n samples by writing the actual number + * of samples computed into *n. Normally, you return zero. + * To indicate that the time of the FIRST sample is the logical stop + * time, return PVSHELL_FLAG_LOGICAL_STOP. (If the logical stop time + * is not at the first sample, but instead at sample j, then just + * return j samples (from 0 to j-1), save the rest of the samples, + * and the next time, the first sample will correspond to the logical + * stop time, so you can return PVSHELL_FLAG_LOGICAL_STOP. + * To indicate that the sound has terminated, return + * PVSHELL_FLAG_TERMINATE. This should be the only time you return + * zero samples. (As with logical stop time, if you have samples to + * return before termination, then do it, and return + * PVSHELL_FLAG_TERMINATE the next time you are called, at which + * point you've returned all the samples, so you can set *n = 0. + */ +struct pvshell_struct; + +typedef long (*h_fn_type)(struct pvshell_struct *susp, + sample_block_values_type out, long *n); + +typedef struct pvshell_struct { + sound_type f; + long f_cnt; + sample_block_values_type f_ptr; + + sound_type g; + long g_cnt; + sample_block_values_type g_ptr; + + long flags; /* for terminated and logically stopped flags */ + + // state is extra storage for whatever you like + double state[PVSHELL_STATE_MAX]; + + // h is a function that computes sound from f, g, x, y, state + h_fn_type h; +} pvshell_node, *pvshell_type; + + +/* to get samples from f or g, use these macros. For each sample, call + * PVSHELL_TEST_X to get logical stop and terminate flags (but do not + * fetch a sample). Then, if you want, call PVSHELL_FETCH_X to get the + * next sample. You can call PVSHELL_TEST_X multiple times before + * calling PVSHELL_FETCH_X, e.g. you can return exit a loop when you + * see a logical stop flag and later call PVSHELL_TEST_X again. You + * CANNOT call PVSHELL_FETCH_X multiples times without an intervening + * call to PVSHELL_TEST_X. Finally, the logical stop flag is only + * returned once. Normally you should write something like: + * new_flags = PVSHELL_TEST_F(susp); + * susp->flags | = new_flags; // remember flags + * if (new_flags) break; + * in the sample loop so that you will break when you see logical_stop. + * Outside the loop, you can return (*n ? 0 : susp->flags) which will + * return 0 if you computed samples before the logical stop was detected. + * Then the next time you are called, you will return the logical_stop + * flag because you saved it in susp->flags, and the flag applies to the + * *beginning* of the sample block. This code handles terminate too. + */ +#define PVSHELL_TEST_F(susp) ((susp)->f_cnt == 0 ? pvshell_test_f(susp) : 0) +#define PVSHELL_FETCH_F(susp) ((susp)->f_cnt--, (*(susp)->f_ptr++)) + +#define PVSHELL_TEST_G(susp) ((susp)->g_cnt == 0 ? pvshell_test_g(susp) : 0) +#define PVSHELL_FETCH_G(susp) ((susp)->g_cnt--, (*(susp)->g_ptr++)) + +/* snd_make_pvshell -- create an instance of pvshell. + name -- string name of the operation, for debugging & printing + (name is not copied. It must be a permanent, immutable string.) + sr -- sample rate of output sound + t0 -- start time of output sound + h -- function that computes samples of output + f -- first input sound, e.g. sound to be time-stretched + g -- second input sound, e.g. sound to control varying stretch factor + state -- initial state information needed by h + n -- number of doubles in state (< PVSHELL_STATE_MAX) +*/ +sound_type snd_make_pvshell(char *name, rate_type sr, time_type t0, + h_fn_type h, sound_type f, sound_type g, + double *state, long n); + diff --git a/nyqsrc/resamp.c b/nyqsrc/resamp.c new file mode 100644 index 0000000..e02e344 --- /dev/null +++ b/nyqsrc/resamp.c @@ -0,0 +1,348 @@ +/* resamp.c -- resample signal using sinc interpolation */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm min->MIN, max->MAX + */ + + + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "assert.h" + +#include "falloc.h" +#include "cext.h" +#include "resamp.h" +#include "fresample.h" +#include "ffilterkit.h" +#include "fsmallfilter.h" + +/* Algorithm: + To resample, we convolve a sinc function with the input stream at +times corresponding to the output samples. This requires a sliding +window on the input samples. Since samples are accessed a block at a +time, the places where the sliding window would span two blocks are +too tricky for me. Instead of trying to manage the breaks across +blocks, I copy the blocks into another buffer (called X). When the +sliding window reaches the end of X, the samples at the end of X +are copied to the beginning of X, the remainder of X is filled with +new samples, and the computation continues. The trickiest part of +all this is keeping all the pointers and phase accumulators correct +when the sliding window is relocated from the end of X to the +beginning. + Although there are different ways to do this, I decided that the +output would always go directly to a Nyquist sample block, so the +resampling routines (SrcUp and SrcUD) are always called upon to +compute max_sample_block_len samples (except that a partial block +may be computed when the input sound terminates). + To compute max_sample_block_len samples, the input buffer needs: + + - max_sample_block_len/factor samples, where factor is the ratio of + the new sample rate to the old one. I.e. if upsampling by a factor + of 2, the input buffer needs half the samples of the output block + size. + + - additional samples the size of the sliding window. Since the + output is taken from the center of the window, we can't take + samples from the first or last windowsize/2 samples. + + - to simplify rounding, we throw in some extra samples. This costs + only a bit of space and an extra copy for each spare sample. + + The window size is determined by the particular filter used and +by factor (the sample rate ratio). The filter size is Nmult, the +number of filter coefficients. When upsampling, this is the window +size (the filter acts as a reconstruction filter for the additional +samples). When downsampling, the filter is stretched by 1/factor +(the filter acts as an anti-aliasing low-pass filter). + +*/ + +void resample_free(); + +typedef struct resample_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + float *X; + long Xsize; + double Time; /* location (offset) in X of next output sample */ + double LpScl; + double factor; + sample_type *Imp; + sample_type *ImpD; + boolean interpFilt; + int Nmult; + int Nwing; + int Xp; /* first free location at end of X */ + int Xoff; /* number of extra samples at beginning and end of X */ +} resample_susp_node, *resample_susp_type; + +/* Sampling rate up-conversion only subroutine; + * Slightly faster than down-conversion; + */ +static int SrcUp(float X[], float Y[], double factor, double *Time, + int Nx, int Nwing, double LpScl, + float Imp[], float ImpD[], boolean Interp) +{ + mem_float *Xp, *Ystart; + fast_float v; + + double dt; /* Step through input signal */ + mem_float *Yend; /* When Y reaches Yend, return to user */ + +/* nyquist_printf("SrcUp: interpFilt %d\n", Interp);*/ + + dt = 1.0/factor; /* Output sampling period */ + + Ystart = Y; + Yend = Y + Nx; + while (Y < Yend) { + long iTime = (long) *Time; + Xp = &X[iTime]; /* Ptr to current input sample */ + /* Perform left-wing inner product */ + v = FilterUp(Imp, ImpD, Nwing, Interp, Xp, *Time - iTime, -1); + /* Perform right-wing inner product */ + v += FilterUp(Imp, ImpD, Nwing, Interp, Xp+1, + (1 + iTime) - *Time, 1); + v *= LpScl; /* Normalize for unity filter gain */ +/* nyquist_printf("SrcUp output sample %g\n", v); */ + *Y++ = (float) v; + *Time += dt; /* Move to next sample by time increment */ + } + return (Y - Ystart); /* Return the number of output samples */ +} + + +/* Sampling rate conversion subroutine */ + +static int SrcUD(float X[], float Y[], double factor, double *Time, + int Nx, int Nwing, double LpScl, + float Imp[], float ImpD[], boolean Interp) +{ + mem_float *Xp, *Ystart; + fast_float v; + + double dh; /* Step through filter impulse response */ + double dt; /* Step through input signal */ + mem_float *Yend; /* When Y reaches Yend, return to user */ + + dt = 1.0/factor; /* Output sampling period */ + + dh = MIN(Npc, factor*Npc); /* Filter sampling period */ + + Ystart = Y; + Yend = Y + Nx; + while (Y < Yend) { + long iTime = (long) *Time; + Xp = &X[iTime]; /* Ptr to current input sample */ + v = FilterUD(Imp, ImpD, Nwing, Interp, Xp, *Time - iTime, + -1, dh); /* Perform left-wing inner product */ + v += FilterUD(Imp, ImpD, Nwing, Interp, Xp+1, (1 + iTime) - *Time, + 1, dh); /* Perform right-wing inner product */ + v *= LpScl; /* Normalize for unity filter gain */ + *Y++ = (float) v; + *Time += dt; /* Move to next sample by time increment */ + } + return (Y - Ystart); /* Return the number of output samples */ +} + + +void resample__fetch(register resample_susp_type susp, snd_list_type snd_list) +{ + int togo; + int n; + int Nout; + sample_block_type out; + /* note that in this fetch routine, out_ptr is used to remember where + * to put the "real" output, while X_ptr_reg is used in the inner + * loop that copies input samples into X, a buffer + */ + register sample_block_values_type out_ptr; + register sample_block_values_type X_ptr_reg; + + register sample_type *s_ptr_reg; + falloc_sample_block(out, "resample__fetch"); + out_ptr = out->samples; + snd_list->block = out; + +/* Algorithm: + Fetch samples until X (the buffered input) is full. X stores enough +contiguous samples that a sliding window convolving with the filter +coefficients can output a full block without sliding beyond the range +of X. Every time we reenter resample__fetch, we take the remaining +samples at the end of X, shift them to the beginning, and refill. + After X is full, call on SrcUp or SrcUD to compute an output block. + The first time resample__fetch is called, the fill pointer Xp will +point near the beginning of X, indicating that no previously read +samples need to be shifted from the end of X to the beginning. +*/ + + /* first, shift samples from end of X to beginning if necessary */ + if (susp->Xp > 2 * susp->Xoff) { + int i; + int shiftcount = (long) (susp->Time) - susp->Xoff; + +/* nyquist_printf("shift %d from %d to %lx\n", susp->Xsize + susp->Xoff - susp->Xp, susp->Xp - susp->Xoff, susp->X); */ + for (i = 0; i < susp->Xp - shiftcount; i++) { + susp->X[i] = susp->X[i + shiftcount]; +/* if (susp->X[i] == 0.0) nyquist_printf("shifted zero to X[%d]\n", i);*/ + } + susp->Time -= shiftcount; + susp->Xp -= shiftcount; + } + + while (susp->Xp < susp->Xsize) { /* outer loop */ + /* read samples from susp->s into X */ + togo = susp->Xsize - susp->Xp; + /* don't run past the s input sample block. If termination or + * logical stop info become available, translate to susp->terminate_cnt + * and susp->log_stop_cnt. + */ + susp_check_term_log_samples(s, s_ptr, s_cnt); + togo = MIN(togo, susp->s_cnt); + + memcpy(susp->X + susp->Xp, susp->s_ptr, togo * sizeof(sample_type)); + susp->s_ptr += togo; + susp_took(s_cnt, togo); + susp->Xp += togo; + } /* outer loop */ + + /* second, compute samples to output, this is done in one pass because + * we have enough data in X + */ + + /* don't run past terminate time */ + togo = max_sample_block_len; + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + max_sample_block_len) { + togo = susp->terminate_cnt - susp->susp.current; + } + if (!susp->logically_stopped && + susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - susp->susp.current; + assert(to_stop >= 0); + if (to_stop < togo) { + if (to_stop == 0) susp->logically_stopped = true; + else togo = to_stop; + } + } + if (togo == 0) { +/* stdputstr("resamp calling snd_list_terminate\n"); */ + snd_list_terminate(snd_list); + } else { + if (susp->factor >= 1) { /* SrcUp() is faster if we can use it */ + Nout = SrcUp(susp->X, out_ptr, susp->factor, &susp->Time, + togo, susp->Nwing, susp->LpScl, susp->Imp, + susp->ImpD, susp->interpFilt); + } else { + Nout = SrcUD(susp->X, out_ptr, susp->factor, &susp->Time, + togo, susp->Nwing, susp->LpScl, susp->Imp, + susp->ImpD, susp->interpFilt); + } + snd_list->block_len = togo; + susp->susp.current += togo; + } +#ifdef RESAMPTEST + for (n = 0; n < snd_list->block_len; n++) { + if (out->samples[n] == 0.0) { + nyquist_printf("resamp: zero at samples[%d]\n", n); + } + } +#endif +/* + if (susp->logically_stopped) { + snd_list->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } + */ +} /* resample__fetch */ + + +void resample_mark(resample_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void resample_free(resample_susp_type susp) +{ + sound_unref(susp->s); + free(susp->X); + ffree_generic(susp, sizeof(resample_susp_node), "resample_free"); +} + + +void resample_print_tree(resample_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_resample(sound_type s, rate_type sr) +{ + register resample_susp_type susp; + int i; + + falloc_generic(susp, resample_susp_node, "snd_make_resample"); + susp->susp.fetch = resample__fetch; + + susp->Nmult = SMALL_FILTER_NMULT; + susp->Imp = SMALL_FILTER_IMP; + susp->ImpD = SMALL_FILTER_IMPD; + /* these scale factors are here because filter coefficients + are expressed as integers, and so is SMALL_FILTER_SCALE: */ + susp->LpScl = SMALL_FILTER_SCALE / 32768.0; + susp->LpScl /= 16384.0; + /* this is just a fudge factor, is SMALL_FILTER_SCALE wrong? */ + susp->LpScl /= 1.0011; + + susp->Nwing = SMALL_FILTER_NWING; + susp->factor = sr / s->sr; + if (susp->factor < 1) susp->LpScl *= susp->factor; + + /* factor in the scale factor of s, since resample is linear */ + susp->LpScl *= s->scale; + + susp->terminate_cnt = UNKNOWN; + /* initialize susp state */ + susp->susp.free = resample_free; + susp->susp.sr = sr; + susp->susp.t0 = s->t0; + susp->susp.mark = resample_mark; + susp->susp.print_tree = resample_print_tree; + susp->susp.name = "resample"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s); + susp->susp.current = 0; + susp->s = s; + susp->s_cnt = 0; + susp->Xoff = (int) (((susp->Nmult + 1) / 2.0) * MAX(1.0, 1.0 / susp->factor) + 10); + susp->Xsize = (long) ((max_sample_block_len / susp->factor) + 2 * susp->Xoff); + susp->X = calloc(susp->Xsize, sizeof(sample_type)); + susp->Xp = susp->Xoff; + susp->Time = susp->Xoff; + susp->interpFilt = true; + for (i = 0; i < susp->Xoff; i++) susp->X[i] = 0.0F; + + return sound_create((snd_susp_type)susp, susp->susp.t0, + susp->susp.sr, 1.0 /* scale factor */); +} + + +sound_type snd_resample(sound_type s, rate_type sr) +{ + sound_type s_copy = sound_copy(s); + return snd_make_resample(s_copy, sr); +} diff --git a/nyqsrc/resamp.h b/nyqsrc/resamp.h new file mode 100644 index 0000000..4f390b8 --- /dev/null +++ b/nyqsrc/resamp.h @@ -0,0 +1,3 @@ +sound_type snd_make_resample(sound_type s, rate_type sr); +sound_type snd_resample(sound_type s, rate_type sr); + /* LISP: (snd-resample SOUND ANYNUM) */ diff --git a/nyqsrc/resampv.c b/nyqsrc/resampv.c new file mode 100644 index 0000000..67dcf7b --- /dev/null +++ b/nyqsrc/resampv.c @@ -0,0 +1,394 @@ +/* resampv.c -- use sinc interpolation to resample at a time-varying sample rate */ + + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm min->MIN, max->MAX + */ + + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "resampv.h" +#include "fresample.h" +#include "ffilterkit.h" +#include "fsmallfilter.h" +#include "assert.h" + + +/* Algorithm: + First compute a factor = ratio of new sample rate to original sample rate. + We have Time, the offset into X + We want Xoff = ((susp->Nmult + 1) / 2.0) * MAX(1.0, 1.0 / factor) + 10 + samples on either side of Time before we interpolate. + If Xoff * 2 > Xsize, then we're in trouble because X is not big enough. + Assume this is a pathalogical case, raise the cutoff frequency to + reduce Xoff to less than Xsize/2. + If Time is too small, then we're in trouble because we've lost the + beginning of the buffer. Raise the cutoff frequency until Xoff is + less than Time. This should only happen if factor suddenly drops. + If Time is too big, we can handle it: shift X down and load X with new + samples. When X is shifted by N samples, N is subtracted from Time. + To minimize the "Time is too small" case, don't shift too far: leave + a cushion of Xoff * 2 samples rather than the usual Xoff. + + Now compute a sample at Time using SrcUD and output it. + + What is Time? + Time is the offset into X, so Time is g_of_now - (sum of all X shifts) + So, let Time = g_of_now - shift_sum + Whenever shift_sum or g_of_now is updated, recompute Time + + To compute the next g_of_now, do a lookup of g at now + 1/sr, + using linear interpolation (be sure to do computation with + doubles to minimize sampling time jitter). + + */ + +/* maximum ratio for downsampling (downsampling will still take place, + * but the lowest prefilter cutoff frequency will be + * (original_sample_rate/2) / MAX_FACTOR_INVERSE + */ +#define MAX_FACTOR_INVERSE 64 + +typedef struct resamplev_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type f; + long f_cnt; + sample_block_values_type f_ptr; + + sound_type g; + long g_cnt; + sample_block_values_type g_ptr; + double prev_g; /* data for interpolation: */ + double next_g; + double phase_in_g; + double phase_in_g_increment; + double g_of_now; + + float *X; + long Xsize; + double Time; /* location (offset) in X of next output sample */ + double shift_sum; /* total amount by which we have shifted X; also, the + sample number of X[0] */ + double LpScl; + double factor_inverse; /* computed at every sample from g */ + /* this is the amount by which we step through the input signal, so + factor_inverse is the output_sample_rate / input_sample_rate, and + factor is the input_sample_rate / output_sample_rate. Alternatively, + factor is the amount to downsample and + factor_inverse is the amount to upsample. */ + /* double factor; -- computed from factor_inverse */ + sample_type *Imp; + sample_type *ImpD; + boolean interpFilt; + int Nmult; + int Nwing; + int Xp; /* first free location at end of X */ + int Xoff; /* number of extra samples at beginning and end of X */ +} resamplev_susp_node, *resamplev_susp_type; + +void resamplev_free(); +void resampv_refill(resamplev_susp_type susp); + +/* Sampling rate conversion subroutine + * Note that this is not the same as SrcUD in resamp.c! + * X[] is the input signal to be resampled, + * dt is the ratio of sample rates; when dt=1, the skip size is + * Npc/dt = Npc, where Npc is how many filter coefficients to + * get the cutoff frequency equal to the Nyquist rate. As dt + * gets larger, we step through the filter more slowly, so low-pass + * filtering occurs. As dt gets smaller, it is X[] that limits + * frequency, and we use the filter to interpolate samples (upsample). + * Therefore, dt>1 means downsample, dt<1 means upsample. + * dt is how much we increment Time to compute each output sample. + * Time is the offset in samples, including fractional samples, of X + * Nwing is the size of one wing of the filter + * LpScl is a corrective scale factor to make the gain == 1 or whatever + * (Nyquist uses a gain of 0.95 to minimize clipping when peaks are + * interpolated.) + * Imp[] and ImpD[] are the filter coefficient table and table differences + * (for interpolation) + * Interp is true to interpolate filter coefficient lookup + */ +static float SrcUD(float X[], double dt, double Time, + int Nwing, double LpScl, + float Imp[], float ImpD[], boolean Interp) +{ + mem_float *Xp; + fast_float v; + + double dh; /* Step through filter impulse response */ + long iTime = (long) Time; + + dh = MIN(Npc, Npc/dt); /* Filter sampling period */ + + Xp = &X[iTime]; /* Ptr to current input sample */ + v = FilterUD(Imp, ImpD, Nwing, Interp, Xp, Time - iTime, + -1, dh); /* Perform left-wing inner product */ + v += FilterUD(Imp, ImpD, Nwing, Interp, Xp+1, (1 + iTime) - Time, + 1, dh); /* Perform right-wing inner product */ + v *= LpScl; /* Normalize for unity filter gain */ + return (float) v; +} + + +void resamplev__fetch(register resamplev_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_block_type out; + /* note that in this fetch routine, out_ptr is used to remember where + * to put the "real" output, while X_ptr_reg is used in the inner + * loop that copies input samples into X, a buffer + */ + register sample_block_values_type out_ptr; + + falloc_sample_block(out, "resamplev__fetch"); + out_ptr = out->samples; + snd_list->block = out; + + + while (cnt < max_sample_block_len) { /* outer loop */ + /* fetch g until we have points to interpolate */ + while (susp->phase_in_g >= 1.0) { + susp->prev_g = susp->next_g; + if (susp->g_cnt == 0) { + susp_get_samples(g, g_ptr, g_cnt); + if (susp->g->logical_stop_cnt == susp->g->current - susp->g_cnt) { + if (susp->susp.log_stop_cnt == UNKNOWN) { + susp->susp.log_stop_cnt = susp->susp.current + cnt; + } + } + if (susp->g_ptr == zero_block->samples && + susp->terminate_cnt == UNKNOWN) { + susp->terminate_cnt = susp->susp.current + cnt; + } + } + susp->next_g = susp_fetch_sample(g, g_ptr, g_cnt); + susp->phase_in_g -= 1.0; + + if (susp->next_g < susp->prev_g) { + susp->next_g = susp->prev_g; // prevent time from going backward + } + /* factor_inverse = 1/factor = how many samples of f per + * output sample = change-in-g / output-samples-per-g-sample + * = change-in-g * phase_in_g_increment + */ + susp->factor_inverse = susp->phase_in_g_increment * + (susp->next_g - susp->prev_g); + if (susp->factor_inverse > MAX_FACTOR_INVERSE) + susp->factor_inverse = MAX_FACTOR_INVERSE; + + /* update Xoff, which depends upon factor_inverse: */ + susp->Xoff = (int) (((susp->Nmult + 1) / 2.0) * + MAX(1.0, susp->factor_inverse)) + 10; + if (susp->Xoff * 2 > susp->Xsize) { + /* bad because X is not big enough for filter, so we'll + * raise the cutoff frequency as necessary + */ + susp->factor_inverse = ((susp->Xsize / 2) - 10 ) / + ((susp->Nmult + 1) / 2.0); + susp->Xoff = (susp->Xsize / 2) - 2 /* fudge factor */; + } + } + susp->g_of_now = susp->prev_g + + susp->phase_in_g * (susp->next_g - susp->prev_g); + susp->Time = susp->g_of_now - susp->shift_sum; + susp->phase_in_g += susp->phase_in_g_increment; + + /* now we have a position (g_of_now) and a factor */ + /* See if enough of f is in X */ + if (susp->Xoff > susp->Time) { + /* there are not enough samples before Time in X, so + * modify factor_inverse to fix it + */ + susp->factor_inverse = (susp->Time - 10.0) / + ((susp->Nmult + 1) / 2.0); + + } else if ((susp->Xsize - susp->Xoff) < susp->Time) { + /* Time is too close to the end of the buffer, slide the samples + down. If there's room, leave 2*Xoff samples at beginning of + * buffer. Otherwise leave as little as Xoff: */ + int i, dist, ntime; + ntime = susp->Xoff * 2; /* shift Time near to this index in X */ + dist = ((int) susp->Time) - ntime; + if (dist < 1 && (ntime * 2 < susp->Xsize)) { + /* not enough room, so leave at least Xoff. */ + ntime = susp->Xoff; + if (susp->Xsize / 2 - ntime > 2) { + /* There is some extra space. Use half to extend ntime, allowing + for a possible increase in Xoff that will require more history; + the other half reduces the amount of buffer copying needed. */ + ntime += (susp->Xsize / 2 - ntime) / 2; + } + dist = ((int) susp->Time) - ntime; + } + /* shift everything in X by dist, adjust Time etc. */ + for (i = 0; i < susp->Xsize - dist; i++) { + susp->X[i] = susp->X[i + dist]; + } + susp->Xp -= dist; + resampv_refill(susp); + susp->shift_sum += dist; + susp->Time = susp->g_of_now - susp->shift_sum; + } + + /* second, compute a sample to output */ + + /* don't run past terminate time */ + if (susp->terminate_cnt == susp->susp.current + cnt) { + snd_list->block_len = cnt; + if (cnt > 0) { + susp->susp.current += cnt; + snd_list = snd_list->u.next; + snd_list->u.next = snd_list_create(&susp->susp); + snd_list->block = internal_zero_block; + snd_list_terminate(snd_list); + } else { + snd_list_terminate(snd_list); + } + return; + } else { + double scale = susp->LpScl; + float tmp; + if (susp->factor_inverse > 1) scale /= susp->factor_inverse; + tmp = SrcUD(susp->X, susp->factor_inverse, + susp->Time, susp->Nwing, scale, susp->Imp, + susp->ImpD, susp->interpFilt); + *out_ptr++ = tmp; + } + cnt++; + } + snd_list->block_len = cnt; + susp->susp.current += cnt; + assert(cnt > 0); +} /* resamplev__fetch */ + + +void resampv_refill(resamplev_susp_type susp) { + int togo, n; + register sample_type *f_ptr_reg; + register sample_type *X_ptr_reg; + + while (susp->Xp < susp->Xsize) { /* outer loop */ + + /* read samples from susp->f into X */ + togo = susp->Xsize - susp->Xp; + + /* don't run past the f input sample block: */ + susp_check_samples(f, f_ptr, f_cnt); + togo = MIN(togo, susp->f_cnt); + + n = togo; + f_ptr_reg = susp->f_ptr; + X_ptr_reg = &(susp->X[susp->Xp]); + if (n) do { /* the inner sample computation loop */ + *X_ptr_reg++ = *f_ptr_reg++; + } while (--n); /* inner loop */ + + /* using f_ptr_reg is a bad idea on RS/6000: */ + susp->f_ptr += togo; + susp_took(f_cnt, togo); + susp->Xp += togo; + } /* outer loop */ +} + + + +void resamplev_mark(resamplev_susp_type susp) +{ + sound_xlmark(susp->f); + sound_xlmark(susp->g); +} + + +void resamplev_free(resamplev_susp_type susp) +{ + sound_unref(susp->f); + sound_unref(susp->g); + free(susp->X); + ffree_generic(susp, sizeof(resamplev_susp_node), "resamplev_free"); +} + + +void resamplev_print_tree(resamplev_susp_type susp, int n) +{ + indent(n); + nyquist_printf("f:"); + sound_print_tree_1(susp->f, n); + + indent(n); + nyquist_printf("g:"); + sound_print_tree_1(susp->g, n); +} + + +sound_type snd_make_resamplev(sound_type f, rate_type sr, sound_type g) +{ + register resamplev_susp_type susp; + int i; + + falloc_generic(susp, resamplev_susp_node, "snd_make_resamplev"); + susp->susp.fetch = resamplev__fetch; + + susp->Nmult = SMALL_FILTER_NMULT; + susp->Imp = SMALL_FILTER_IMP; + susp->ImpD = SMALL_FILTER_IMPD; + susp->LpScl = SMALL_FILTER_SCALE / 32768.0; + susp->LpScl /= 16384.0; + /* this is just a fudge factor, is SMALL_FILTER_SCALE wrong? */ + susp->LpScl /= 1.0011; + susp->Nwing = SMALL_FILTER_NWING; + + susp->terminate_cnt = UNKNOWN; + /* initialize susp state */ + susp->susp.free = resamplev_free; + susp->susp.sr = sr; + susp->susp.t0 = f->t0; + susp->susp.mark = resamplev_mark; + susp->susp.print_tree = resamplev_print_tree; + susp->susp.name = "resamplev"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(f); + susp->susp.current = 0; + susp->f = f; + susp->f_cnt = 0; + susp->g = g; + susp->g_cnt = 0; + susp->next_g = 0; + susp->phase_in_g_increment = g->sr / sr; + susp->phase_in_g = 2.0; + /* can't use susp->factor because it is unknown and variable */ + /* assume at most a down-sample by a factor of 2.0 and compute Xoff accordingly */ + susp->Xoff = (int) (((susp->Nmult + 1) / 2.0) * 2.0) /* MAX(1.0, 1.0 / susp->factor) */ + 10; + /* this size is not critical unless it is too small */ + /* allow the block size plus a buffer of 2*Xoff at both ends for the tails of the filter */ + susp->Xsize = max_sample_block_len + 4 * susp->Xoff; + susp->X = calloc(susp->Xsize, sizeof(sample_type)); + susp->Xp = susp->Xsize; + susp->shift_sum = -susp->Xsize; + susp->interpFilt = true; + for (i = 0; i < susp->Xoff; i++) susp->X[i] = 0.0F; + susp->LpScl *= 0.95; /* reduce probability of clipping */ + + return sound_create((snd_susp_type)susp, susp->susp.t0, susp->susp.sr, + 1.0 /* scale factor */); +} + + +sound_type snd_resamplev(sound_type f, rate_type sr, sound_type g) +{ + sound_type f_copy = sound_copy(f); + sound_type g_copy = sound_copy(g); + g_copy->scale *= (float) sr; /* put g_copy in units of samples */ + return snd_make_resamplev(f_copy, sr, g_copy); +} diff --git a/nyqsrc/resampv.h b/nyqsrc/resampv.h new file mode 100644 index 0000000..ceec942 --- /dev/null +++ b/nyqsrc/resampv.h @@ -0,0 +1,3 @@ +sound_type snd_make_resamplev(sound_type f, rate_type sr, sound_type g); +sound_type snd_resamplev(sound_type f, rate_type sr, sound_type g); + /* LISP: (snd-resamplev SOUND ANYNUM SOUND) */ diff --git a/nyqsrc/rfftw.h b/nyqsrc/rfftw.h new file mode 100644 index 0000000..1d71ec7 --- /dev/null +++ b/nyqsrc/rfftw.h @@ -0,0 +1,98 @@ +/* + * Copyright (c) 1997-1999 Massachusetts Institute of Technology + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * + */ + +/* rfftw.h -- system-wide definitions for rfftw */ +#ifndef RFFTW_H +#define RFFTW_H + +#include <fftw.h> + +#ifdef __cplusplus +extern "C" { +#endif /* __cplusplus */ + +/****************************************************************************/ + +#define RFFTW_V2 + +typedef fftw_plan rfftw_plan; +typedef fftwnd_plan rfftwnd_plan; + +#define FFTW_REAL_TO_COMPLEX FFTW_FORWARD +#define FFTW_COMPLEX_TO_REAL FFTW_BACKWARD + +extern void rfftw(rfftw_plan plan, int howmany, fftw_real *in, int istride, + int idist, fftw_real *out, int ostride, int odist); +extern void rfftw_one(rfftw_plan plan, fftw_real *in, fftw_real *out); + +extern rfftw_plan rfftw_create_plan_specific(int n, fftw_direction dir, + int flags, + fftw_real *in, int istride, + fftw_real *out, int ostride); + +extern rfftw_plan rfftw_create_plan(int n, fftw_direction dir, int flags); +extern void rfftw_destroy_plan(rfftw_plan plan); + +extern void rfftw_fprint_plan(FILE *f, rfftw_plan p); +extern void rfftw_print_plan(rfftw_plan p); + +extern void rfftw_executor_simple(int n, fftw_real *in, + fftw_real *out, + fftw_plan_node *p, + int istride, + int ostride); + +extern rfftwnd_plan rfftwnd_create_plan_specific(int rank, const int *n, + fftw_direction dir, int flags, + fftw_real *in, int istride, + fftw_real *out, int ostride); +extern rfftwnd_plan rfftw2d_create_plan_specific(int nx, int ny, + fftw_direction dir, int flags, + fftw_real *in, int istride, + fftw_real *out, int ostride); +extern rfftwnd_plan rfftw3d_create_plan_specific(int nx, int ny, int nz, + fftw_direction dir, int flags, + fftw_real *in, int istride, + fftw_real *out, int ostride); +extern rfftwnd_plan rfftwnd_create_plan(int rank, const int *n, + fftw_direction dir, int flags); +extern rfftwnd_plan rfftw2d_create_plan(int nx, int ny, + fftw_direction dir, int flags); +extern rfftwnd_plan rfftw3d_create_plan(int nx, int ny, int nz, + fftw_direction dir, int flags); +extern void rfftwnd_destroy_plan(rfftwnd_plan plan); +extern void rfftwnd_fprint_plan(FILE *f, rfftwnd_plan plan); +extern void rfftwnd_print_plan(rfftwnd_plan plan); +extern void rfftwnd_real_to_complex(rfftwnd_plan p, int howmany, + fftw_real *in, int istride, int idist, + fftw_complex *out, int ostride, int odist); +extern void rfftwnd_complex_to_real(rfftwnd_plan p, int howmany, + fftw_complex *in, int istride, int idist, + fftw_real *out, int ostride, int odist); +extern void rfftwnd_one_real_to_complex(rfftwnd_plan p, + fftw_real *in, fftw_complex *out); +extern void rfftwnd_one_complex_to_real(rfftwnd_plan p, + fftw_complex *in, fftw_real *out); + +/****************************************************************************/ + +#ifdef __cplusplus +} /* extern "C" */ +#endif /* __cplusplus */ +#endif /* RFFTW_H */ diff --git a/nyqsrc/samples.c b/nyqsrc/samples.c new file mode 100644 index 0000000..e841f67 --- /dev/null +++ b/nyqsrc/samples.c @@ -0,0 +1,304 @@ +/* samples.c -- various functions for the Nyquist sound data type */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm min->MIN, max->MAX + */ + +#include <stdio.h> +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "samples.h" + + +LVAL s_next = NULL; +LVAL s_send; + +void samples_symbols() +{ + s_next = xlenter(":NEXT"); + s_send = xlenter("SEND"); +} + +/* snd_from_array -- convert lisp array to sound type */ +/**/ +sound_type snd_from_array(double t0, double sr, LVAL array) +{ + sound_type result; + snd_list_type snd_list; + long total = 0; + + if (!vectorp(array)) xlerror("array expected", array); + + result = sound_create(NULL, t0, sr, 1.0); + snd_list = result->list; + while (total < getsize(array)) { + long togo = MIN(getsize(array) - total, max_sample_block_len); + sample_block_type block; + int i; + falloc_sample_block(block, "snd_from_array"); + snd_list->block = block; + for (i = 0; i < togo; i++) { + LVAL elem = getelement(array, total + i); + sample_type *ptr = block->samples + i; + if (fixp(elem)) *ptr = (sample_type) getfixnum(elem); + else if (floatp(elem)) *ptr = (sample_type) getflonum(elem); + else xlerror("expecting array elem to be number", elem); + } + total += togo; + snd_list->block_len = (short) togo; + snd_list->u.next = snd_list_create(NULL); + snd_list = snd_list->u.next; + } + snd_list->block_len = max_sample_block_len; + snd_list->block = zero_block; + snd_list->logically_stopped = true; + snd_list->u.next = zero_snd_list; + return result; +} + + +/* snd_length -- count how many samples are in a sound */ +/**/ +long snd_length(sound_type s, long len) +{ + long total = 0; + long blocklen; + + s = sound_copy(s); + if (len > s->stop) len = s->stop; + while (total < len) { + sample_block_type sampblock = sound_get_next(s, &blocklen); + if (sampblock == zero_block) break; + total += blocklen; + } + if (total > len) total = len; + sound_unref(s); + return total; +} + + +/* snd_maxsamp -- compute the maximum value of samples in s */ +/**/ +double snd_maxsamp(sound_type s) +{ + sample_type result = 0.0F; + long blocklen; + s = sound_copy(s); + + while (true) { + sample_block_type sampblock = sound_get_next(s, &blocklen); + long i; + sample_block_values_type sbufp = sampblock->samples; + if (sampblock == zero_block || blocklen == 0) { + break; + } + for (i = 0; i < blocklen; i++) { + register sample_type samp = *sbufp++; + if (result < samp) result = samp; + else if (result < -samp) result = -samp; + } + } + return (double) (s->scale * result); +} + + +/* snd_samples -- convert sound (prefix) to lisp array */ +/**/ +LVAL snd_samples(sound_type s, long len) +{ + LVAL v; + long vx = 0; + long blocklen; + register double scale_factor = s->scale; + len = snd_length(s, len); + s = sound_copy(s); + + xlsave1(v); + v = newvector(len); + + while (len > 0) { + sample_block_type sampblock = sound_get_next(s, &blocklen); + long togo = MIN(blocklen, len); + long i; + sample_block_values_type sbufp = sampblock->samples; + for (i = 0; i < togo; i++) { + setelement(v, vx++, cvflonum(*sbufp++ * scale_factor)); + } + len -= togo; + } + sound_unref(s); + + /* restore the stack */ + xlpop(); + return v; +} + + +/* NOTE: this code does not properly handle start times that do not + * correspond to the time of the first actual sample + */ + +/* NOTE: we need some addtional state to keep track of where we are. + * We'll use the extra field of sound_type; first long is length, + * so second field will be the count of how many samples we've read. + */ +#define CNT extra[1] +#define INDEX extra[2] +#define FIELDS 3 +#define SAMPLES list->block->samples + +LVAL snd_fetch(sound_type s) +{ + if (!s->extra) { /* this is the first call, so fix up s */ + s->extra = (long *) malloc(sizeof(long) * FIELDS); + s->extra[0] = sizeof(long) * FIELDS; + s->CNT = s->INDEX = 0; + } else if (s->extra[0] != sizeof(long) * FIELDS) { + xlfail("sound in use by another iterator"); + } + if (s->CNT == s->INDEX) { + sound_get_next(s, &(s->CNT)); + s->INDEX = 0; + } + if (s->SAMPLES == zero_block->samples) { + return NULL; + } + + /* logical stop time is ignored by this code -- to fix this, + * you would need a way to return the logical stop time to + * the caller. + */ + + return cvflonum(s->SAMPLES[s->INDEX++] * s->scale); +} /* snd_fetch */ + + +/* snd_fetch_array -- fetch a lisp array of samples */ +/* + * storage layout: the extra field points to extra state that we'll use + * extra[0] -> length of extra storage + * extra[1] -> CNT (number of samples in current block) + * extra[2] -> INDEX (current sample index in current block) + * extra[3] -> FILLCNT (how many samples in buffer) + * extra[4] -> TERMCNT (how many samples until termination) + * extra[4 .. 4+len-1] -> samples (stored as floats) + * + * Termination details: + * Return NIL when the sound terminates. + * Termination is defined as the point where all original + * signal samples have been shifted out of the samples buffer + * so that all that's left are zeros from beyond the termination + * point. + * Implementation: when termination is discovered, set TERMCNT + * to the number of samples to be shifted out. TERMCNT is initially + * -1 as a flag that we haven't seen the termination yet. + * Each time samples are shifted, decrement TERMCNT by the shift amount. + * When TERMCNT goes to zero, return NULL. + */ +/* these macros define entries in extra, more macros are defined above */ +#define FILLCNT extra[3] +#define TERMCNT extra[4] +#define OFFSET 5 + +LVAL snd_fetch_array(sound_type s, long len, long step) +{ + long i, maxlen, skip, fillptr; + float *samples; + LVAL result; + LVAL rslt_symbol = xlenter("*RSLT*"); + + setvalue(rslt_symbol, NULL); + + if (len < 1) xlfail("len < 1"); + + if (!s->extra) { /* this is the first call, so fix up s */ + s->extra = (long *) malloc(sizeof(long) * (len + OFFSET)); + s->extra[0] = sizeof(long) * (len + OFFSET); + s->CNT = s->INDEX = s->FILLCNT = 0; + s->TERMCNT = -1; + maxlen = len; + } else { + maxlen = (s->extra[0] / sizeof(long)) - OFFSET; + if (maxlen < 1) xlfail("sound in use by another iterator"); + if (maxlen < len) xlfail("len grew"); + } + samples = (float *) &(s->extra[OFFSET]); + + /* step 1: refill buffer with samples */ + fillptr = s->FILLCNT; + while (fillptr < maxlen) { + if (s->INDEX == s->CNT) { + sound_get_next(s, &(s->CNT)); + if (s->SAMPLES == zero_block->samples) { + setvalue(rslt_symbol, cvfixnum(fillptr)); + if (s->TERMCNT < 0) s->TERMCNT = fillptr; + } + s->INDEX = 0; + } + samples[fillptr++] = s->SAMPLES[s->INDEX++] * s->scale; + } + s->FILLCNT = fillptr; + + /* it is important to test here AFTER filling the buffer, because + * if fillptr WAS 0 when we hit the zero_block, then filling the + * buffer will set TERMCNT to 0. + */ + if (s->TERMCNT == 0) return NULL; + + /* logical stop time is ignored by this code -- to fix this, + * you would need a way to return the logical stop time to + * the caller. + */ + + /* step 2: construct an array and return it */ + xlsave1(result); + result = newvector(len); + + for (i = 0; i < len; i++) { + setelement(result, i, cvflonum(samples[i])); + } + + /* step 3: shift samples by step */ + if (step < 0) xlfail("step < 0"); + s->FILLCNT -= step; + if (s->FILLCNT < 0) s->FILLCNT = 0; + for (i = 0; i < s->FILLCNT; i++) { + samples[i] = samples[i + step]; + } + + + if (s->TERMCNT >= 0) { + s->TERMCNT -= step; + if (s->TERMCNT < 0) s->TERMCNT = 0; + } + + + /* step 4: advance in sound to next sample we need + * (only does work if step > size of buffer) + */ + skip = step - maxlen; + while (skip > 0) { + long remaining = s->CNT - s->INDEX; + if (remaining >= skip) { + s->INDEX += skip; + skip = 0; + } else { + skip -= remaining; + sound_get_next(s, &(s->CNT)); + s->INDEX = 0; + } + } + + /* restore the stack */ + xlpop(); + return result; +} /* snd_fetch_array */ + + + + diff --git a/nyqsrc/samples.h b/nyqsrc/samples.h new file mode 100644 index 0000000..8907241 --- /dev/null +++ b/nyqsrc/samples.h @@ -0,0 +1,20 @@ +/* samples.h -- convert sound (prefix) to lisp array */ + +/* these are used by snd_fromobject and snd_fromarraystream: */ +extern LVAL s_next; +extern LVAL s_send; + +void samples_symbols(); + +sound_type snd_from_array(double t0, double sr, LVAL array); + /* LISP: (SND-FROM-ARRAY ANYNUM ANYNUM ANY) */ + +LVAL snd_samples(sound_type s, long len); /* LISP: (SND-SAMPLES SOUND FIXNUM) */ +long snd_length(sound_type s, long len); /* LISP: (SND-LENGTH SOUND FIXNUM) */ + +double snd_maxsamp(sound_type s); /* LISP: (SND-MAXSAMP SOUND) */ + +LVAL snd_fetch(sound_type s); /* LISP: (SND-FETCH SOUND) */ + +LVAL snd_fetch_array(sound_type s, long len, long step); + /* LISP: (SND-FETCH-ARRAY SOUND FIXNUM FIXNUM) */ diff --git a/nyqsrc/seqext.c b/nyqsrc/seqext.c new file mode 100644 index 0000000..804641a --- /dev/null +++ b/nyqsrc/seqext.c @@ -0,0 +1,92 @@ +/* seqext.c -- seq extensions for xlisp */ +/* +This file extends xlisp with the data type SEQ, including functions +to print and free SEQ type objects. + */ + +/* (c) Copyright Carnegie Mellon University 1991, 1994 + * For a statement of limited permission to use, see Permission.doc + */ + + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm portability fix: use %p instead of %lx + */ + + +#include "stdio.h" +#include "xlisp.h" +#include "cext.h" +#include "userio.h" +#include "midifns.h" +#include "timebase.h" +#include "seq.h" +#include "moxc.h" +#include "seqread.h" +#include "seqext.h" +#include "extern.h" + +LVAL s_seq; + +xtype_desc seq_desc; + +static void xlseq_print(); + +void nop() {} + +boolean seqp(s) + LVAL s; +{ + return exttypep(s, s_seq); +} + + +/* xlseq_free gets called by xlisp when the GC frees a seq object. + * seq_free is a macro, so here we make it into a function pointer. + */ +static void xlseq_free(sequence) +seq_type sequence; +{ + seq_free(sequence); +} + + +static void xlseq_print(fptr, sequence) + LVAL fptr; + seq_type sequence; +{ + char s[32]; + sprintf(s, "#<SEQ:0x%p>", sequence); + xlputstr(fptr, s); +} + +static void xlseq_save(fp, sequence) + FILE *fp; + seq_type sequence; +{ + errputstr("xlseq_save called\n"); +} + + +static unsigned char *xlseq_restore(fp) + FILE *fp; +{ + errputstr("xlseq_restore called\n"); + return 0; +} + + +void seqext_init() +{ +/* printf("localinit called\n"); */ + seq_desc = create_desc("SEQ", xlseq_free, xlseq_print, xlseq_save, + xlseq_restore, NULL); + moxcinit(0, (char **) NULL); +} + + +void seqext_symbols() +{ + s_seq = xlenter("SEQ"); +} diff --git a/nyqsrc/seqext.h b/nyqsrc/seqext.h new file mode 100644 index 0000000..0727e77 --- /dev/null +++ b/nyqsrc/seqext.h @@ -0,0 +1,14 @@ +/* seqext.h -- header for seq extensions for xlisp */ + + +void seqext_init(); +void seqext_symbols(); +boolean seqp(); + +extern xtype_desc seq_desc; +extern LVAL s_seq; + +#define cvptrbool(v) ((LVAL) ((v) ? s_true : NIL)) +#define cvseq(v) ((LVAL) ((v) ? cvextern(seq_desc, (void *)(v)) : NIL)) +#define xlgaseq() (testarg(typearg(seqp))) +#define getseq(x) ((seq_type) getinst(x)) diff --git a/nyqsrc/seqfn.cl b/nyqsrc/seqfn.cl new file mode 100644 index 0000000..2a22761 --- /dev/null +++ b/nyqsrc/seqfn.cl @@ -0,0 +1,2 @@ +:nyqsrc:seqfnint :cmt:seqdecls.h :nyqsrc:seqext.h :cmt:seq.h :nyqsrc:seqinterf.h +:cmt:seqread.h :cmt:seqmread.h :cmt:seqwrite.h :cmt:seqmwrite.h diff --git a/nyqsrc/seqfn.wcl b/nyqsrc/seqfn.wcl new file mode 100644 index 0000000..8f58d02 --- /dev/null +++ b/nyqsrc/seqfn.wcl @@ -0,0 +1,2 @@ +nyqsrc\seqfnint cmt\seqdecls.h nyqsrc\seqext.h cmt\seq.h nyqsrc\seqinterf.h +cmt\seqread.h cmt\seqmread.h cmt\seqwrite.h cmt\seqmwrite.h diff --git a/nyqsrc/seqfnint.c b/nyqsrc/seqfnint.c new file mode 100644 index 0000000..9424097 --- /dev/null +++ b/nyqsrc/seqfnint.c @@ -0,0 +1,249 @@ +/* nyqsrc/seqfnint.c -- interface to cmt/seqdecls.h, + * nyqsrc/seqext.h, cmt/seq.h, nyqsrc/seqinterf.h, + * cmt/seqread.h, cmt/seqmread.h, cmt/seqwrite.h, + * cmt/seqmwrite.h */ + +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" + +extern LVAL s_true; +#define cvboolean(i) ((i) ? s_true : NIL) +#define testarg2(e) (moreargs() ? (e) : (getflonum(xltoofew()))) +#define xlgaanynum() (floatp(*xlargv) ? getflonum(nextarg()) : \ + (fixp(*xlargv) ? (double) getfixnum(nextarg()) : \ + getflonum(xlbadtype(*xlargv)))) +#define getboolean(lval) ((lval) != NIL) + +extern LVAL RSLT_sym; + + +#include "seqdecls.h" + +#include "seqext.h" + +#include "seq.h" + +/* xlc_seq_reset -- interface to C routine seq_reset */ +/**/ +LVAL xlc_seq_reset(void) +{ + seq_type arg1 = getseq(xlgaseq()); + + xllastarg(); + seq_reset(arg1); + return NIL; +} + + +/* xlc_seq_insert_ctrl -- interface to C routine insert_ctrl */ +/**/ +LVAL xlc_seq_insert_ctrl(void) +{ + seq_type arg1 = getseq(xlgaseq()); + long arg2 = getfixnum(xlgafixnum()); + long arg3 = getfixnum(xlgafixnum()); + long arg4 = getfixnum(xlgafixnum()); + long arg5 = getfixnum(xlgafixnum()); + long arg6 = getfixnum(xlgafixnum()); + + xllastarg(); + insert_ctrl(arg1, arg2, arg3, arg4, arg5, arg6); + return NIL; +} + + +/* xlc_seq_insert_ramp -- interface to C routine insert_ctrlramp */ +/**/ +LVAL xlc_seq_insert_ramp(void) +{ + seq_type arg1 = getseq(xlgaseq()); + long arg2 = getfixnum(xlgafixnum()); + long arg3 = getfixnum(xlgafixnum()); + long arg4 = getfixnum(xlgafixnum()); + long arg5 = getfixnum(xlgafixnum()); + long arg6 = getfixnum(xlgafixnum()); + long arg7 = getfixnum(xlgafixnum()); + long arg8 = getfixnum(xlgafixnum()); + long arg9 = getfixnum(xlgafixnum()); + + xllastarg(); + insert_ctrlramp(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); + return NIL; +} + + +/* xlc_seq_insert_macctrl -- interface to C routine insert_macctrl */ +/**/ +LVAL xlc_seq_insert_macctrl(void) +{ + seq_type arg1 = getseq(xlgaseq()); + long arg2 = getfixnum(xlgafixnum()); + long arg3 = getfixnum(xlgafixnum()); + long arg4 = getfixnum(xlgafixnum()); + long arg5 = getfixnum(xlgafixnum()); + long arg6 = getfixnum(xlgafixnum()); + + xllastarg(); + insert_macctrl(arg1, arg2, arg3, arg4, arg5, arg6); + return NIL; +} + + +/* xlc_seq_insert_note -- interface to C routine insert_note */ +/**/ +LVAL xlc_seq_insert_note(void) +{ + seq_type arg1 = getseq(xlgaseq()); + long arg2 = getfixnum(xlgafixnum()); + long arg3 = getfixnum(xlgafixnum()); + long arg4 = getfixnum(xlgafixnum()); + long arg5 = getfixnum(xlgafixnum()); + long arg6 = getfixnum(xlgafixnum()); + long arg7 = getfixnum(xlgafixnum()); + + xllastarg(); + insert_note(arg1, arg2, arg3, arg4, arg5, arg6, arg7); + return NIL; +} + + +/* xlc_seq_copy -- interface to C routine seq_copy */ +/**/ +LVAL xlc_seq_copy(void) +{ + seq_type arg1 = getseq(xlgaseq()); + seq_type result; + + xllastarg(); + result = seq_copy(arg1); + return cvseq(result); +} + + +/* xlc_seq_create -- interface to C routine seq_create */ +/**/ +LVAL xlc_seq_create(void) +{ + seq_type result; + + xllastarg(); + result = seq_create(); + return cvseq(result); +} + + +#include "seqinterf.h" + +/* xlc_seq_next -- interface to C routine seq_next */ +/**/ +LVAL xlc_seq_next(void) +{ + seq_type arg1 = getseq(xlgaseq()); + boolean result; + + xllastarg(); + result = seq_next(arg1); + return cvboolean(result); +} + + +/* xlc_seq_get -- interface to C routine seq_get */ +/**/ +LVAL xlc_seq_get(void) +{ + seq_type arg1 = getseq(xlgaseq()); + long arg2 = 0; + long arg3 = 0; + long arg4 = 0; + long arg5 = 0; + long arg6 = 0; + long arg7 = 0; + long arg8 = 0; + LVAL result; + + xllastarg(); + seq_get(arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arg7, &arg8); + { LVAL *next = &getvalue(RSLT_sym); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg2); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg3); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg4); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg5); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg6); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg7); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg8); + } + result = getvalue(RSLT_sym); + return result; +} + + +#include "seqread.h" + +/* xlc_seq_read -- interface to C routine seq_read */ +/**/ +LVAL xlc_seq_read(void) +{ + seq_type arg1 = getseq(xlgaseq()); + FILE * arg2 = getfile(xlgastream()); + + xllastarg(); + seq_read(arg1, arg2); + return NIL; +} + + +#include "seqmread.h" + +/* xlc_seq_read_smf -- interface to C routine seq_read_smf */ +/**/ +LVAL xlc_seq_read_smf(void) +{ + seq_type arg1 = getseq(xlgaseq()); + FILE * arg2 = getfile(xlgastream()); + + xllastarg(); + seq_read_smf(arg1, arg2); + return NIL; +} + + +#include "seqwrite.h" + +/* xlc_seq_write -- interface to C routine seq_write */ +/**/ +LVAL xlc_seq_write(void) +{ + seq_type arg1 = getseq(xlgaseq()); + FILE * arg2 = getfile(xlgastream()); + int arg3 = getboolean(xlgetarg()); + + xllastarg(); + seq_write(arg1, arg2, arg3); + return NIL; +} + + +#include "seqmwrite.h" + +/* xlc_seq_write_smf -- interface to C routine seq_write_smf */ +/**/ +LVAL xlc_seq_write_smf(void) +{ + seq_type arg1 = getseq(xlgaseq()); + FILE * arg2 = getfile(xlgastream()); + + xllastarg(); + seq_write_smf(arg1, arg2); + return NIL; +} + + diff --git a/nyqsrc/seqfnint.lsp b/nyqsrc/seqfnint.lsp new file mode 100644 index 0000000..1f7b01b --- /dev/null +++ b/nyqsrc/seqfnint.lsp @@ -0,0 +1,31 @@ + + (setfn seq-tag first) + (setfn seq-time second) + (setfn seq-line third) + (setfn seq-channel fourth) + (defun seq-value1 (e) (nth 4 e)) + (setfn seq-pitch seq-value1) ; pitch of a note + (setfn seq-control seq-value1) ; control number of a control change + (setfn seq-program seq-value1) ; program number of a program change + (setfn seq-bend seq-value1) ; pitch bend amount + (setfn seq-touch seq-value1) ; aftertouch amount + (defun seq-value2 (e) (nth 5 e)) + (setfn seq-velocity seq-value2) ; velocity of a note + (setfn seq-value seq-value2) ; value of a control change + (defun seq-duration (e) (nth 6 e)) + + + (setf seq-done-tag 0) + + (setf seq-other-tag 1) + + (setf seq-note-tag 2) + + (setf seq-ctrl-tag 3) + + (setf seq-prgm-tag 4) + + (setf seq-touch-tag 5) + + (setf seq-bend-tag 6) + diff --git a/nyqsrc/seqfnintdefs.h b/nyqsrc/seqfnintdefs.h new file mode 100644 index 0000000..ba09956 --- /dev/null +++ b/nyqsrc/seqfnintdefs.h @@ -0,0 +1,13 @@ +extern LVAL xlc_seq_reset(void); +extern LVAL xlc_seq_insert_ctrl(void); +extern LVAL xlc_seq_insert_ramp(void); +extern LVAL xlc_seq_insert_macctrl(void); +extern LVAL xlc_seq_insert_note(void); +extern LVAL xlc_seq_copy(void); +extern LVAL xlc_seq_create(void); +extern LVAL xlc_seq_next(void); +extern LVAL xlc_seq_get(void); +extern LVAL xlc_seq_read(void); +extern LVAL xlc_seq_read_smf(void); +extern LVAL xlc_seq_write(void); +extern LVAL xlc_seq_write_smf(void); diff --git a/nyqsrc/seqfnintptrs.h b/nyqsrc/seqfnintptrs.h new file mode 100644 index 0000000..9defce5 --- /dev/null +++ b/nyqsrc/seqfnintptrs.h @@ -0,0 +1,13 @@ + { "SEQ-RESET", S, xlc_seq_reset}, + { "SEQ-INSERT-CTRL", S, xlc_seq_insert_ctrl}, + { "SEQ-INSERT-RAMP", S, xlc_seq_insert_ramp}, + { "SEQ-INSERT-MACCTRL", S, xlc_seq_insert_macctrl}, + { "SEQ-INSERT-NOTE", S, xlc_seq_insert_note}, + { "SEQ-COPY", S, xlc_seq_copy}, + { "SEQ-CREATE", S, xlc_seq_create}, + { "SEQ-NEXT", S, xlc_seq_next}, + { "SEQ-GET", S, xlc_seq_get}, + { "SEQ-READ", S, xlc_seq_read}, + { "SEQ-READ-SMF", S, xlc_seq_read_smf}, + { "SEQ-WRITE", S, xlc_seq_write}, + { "SEQ-WRITE-SMF", S, xlc_seq_write_smf}, diff --git a/nyqsrc/seqinterf.c b/nyqsrc/seqinterf.c new file mode 100644 index 0000000..dc886a0 --- /dev/null +++ b/nyqsrc/seqinterf.c @@ -0,0 +1,98 @@ +/* seqinterf.c -- interface to sequence data type for XLISP */ + +#include "switches.h" +#include "xlisp.h" +#include "stdio.h" +#include "cext.h" +#include "userio.h" +#include "midifns.h" +#include "timebase.h" +#include "moxc.h" +#include "seq.h" +#include "seqinterf.h" + +/* seq_next -- advance to the next event, return TRUE if found */ +/**/ +boolean seq_next(seq_type seq) +{ + if (seq->current) { + seq->current = seq->current->next; + } + return seq->current != NULL; +} + + +/* seq_get -- get event data for the current event */ +/**/ +void seq_get(seq_type seq, long *eventtype, long *ntime, long *line, long *chan, + long *value1, long *value2, long *dur) +{ + event_type ev = seq->current; + if (!ev) *eventtype = SEQ_DONE; + else if (is_note(ev)) { + if (ev->value != NO_PITCH) { + *eventtype = SEQ_NOTE; + *ntime = ev->ntime; + *line = ev->nline; + *chan = vc_voice(ev->nvoice); + *value1 = ev->value; + *value2 = ev->u.note.ndur & 0xFF; + *dur = ev->u.note.ndur >> 8; + } else { + *eventtype = SEQ_OTHER; + } + } else { + *eventtype = SEQ_CTRL; + *ntime = ev->ntime; + *line = ev->nline; + *chan = vc_voice(ev->nvoice); + *value2 = ev->value; + + switch (vc_ctrl(ev->nvoice)) { + case PSWITCH_CTRL: + *value1 = PORTASWITCH; + break; + case MODWHEEL_CTRL: + *value1 = MODWHEEL; + break; + case TOUCH_CTRL: + *eventtype = SEQ_TOUCH; + *value1 = ev->value; + break; + case VOLUME_CTRL: + *value1 = VOLUME; + break; + case BEND_CTRL: + *eventtype = SEQ_BEND; + *value1 = ev->value << 6; + break; + case PROGRAM_CTRL: + *eventtype = SEQ_PRGM; + *value1 = ev->value + 1; + break; + case ESC_CTRL: + switch (ev->value) { + case CALL_VALUE: + case CLOCK_VALUE: + case MACRO_VALUE: + case CTRLRAMP_VALUE: + case DEFRAMP_VALUE: + case SETI_VALUE: + *eventtype = SEQ_OTHER; + break; + case MACCTRL_VALUE: + *value1 = ev->u.macctrl.ctrl_number; + *value2 = ev->u.macctrl.value; + break; + default: + xlabort("unexpected ESC_CTRL value\n"); + break; + } + break; + default: + xlabort("unexpected seq data\n"); + break; + } + } +} + diff --git a/nyqsrc/seqinterf.h b/nyqsrc/seqinterf.h new file mode 100644 index 0000000..590ed84 --- /dev/null +++ b/nyqsrc/seqinterf.h @@ -0,0 +1,37 @@ +/* seqinterf.h -- interface to sequence data type for XLISP */ + +boolean seq_next(seq_type seq); /* LISP: (SEQ-NEXT SEQ) */ +void seq_get(seq_type seq, long *eventtype, long *time, long *line, long *chan, + long *value1, long *value2, long *dur); + /* LISP: (SEQ-GET SEQ FIXNUM^ FIXNUM^ FIXNUM^ FIXNUM^ FIXNUM^ FIXNUM^ FIXNUM^) */ +/* LISP-SRC: + (setfn seq-tag first) + (setfn seq-time second) + (setfn seq-line third) + (setfn seq-channel fourth) + (defun seq-value1 (e) (nth 4 e)) + (setfn seq-pitch seq-value1) ; pitch of a note + (setfn seq-control seq-value1) ; control number of a control change + (setfn seq-program seq-value1) ; program number of a program change + (setfn seq-bend seq-value1) ; pitch bend amount + (setfn seq-touch seq-value1) ; aftertouch amount + (defun seq-value2 (e) (nth 5 e)) + (setfn seq-velocity seq-value2) ; velocity of a note + (setfn seq-value seq-value2) ; value of a control change + (defun seq-duration (e) (nth 6 e)) + */ +#define SEQ_DONE 0 +/* LISP-SRC: (setf seq-done-tag 0) */ +#define SEQ_OTHER 1 +/* LISP-SRC: (setf seq-other-tag 1) */ +#define SEQ_NOTE 2 +/* LISP-SRC: (setf seq-note-tag 2) */ +#define SEQ_CTRL 3 +/* LISP-SRC: (setf seq-ctrl-tag 3) */ +#define SEQ_PRGM 4 +/* LISP-SRC: (setf seq-prgm-tag 4) */ +#define SEQ_TOUCH 5 +/* LISP-SRC: (setf seq-touch-tag 5) */ +#define SEQ_BEND 6 +/* LISP-SRC: (setf seq-bend-tag 6) */ + diff --git a/nyqsrc/sliders.c b/nyqsrc/sliders.c new file mode 100644 index 0000000..9e07132 --- /dev/null +++ b/nyqsrc/sliders.c @@ -0,0 +1,160 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "sliders.h" +#include "sndsliders.h" + +float slider_array[SLIDERS_MAX]; + + +void set_slider(int index, float value) +{ + if (index >= 0 && index < SLIDERS_MAX) { + slider_array[index] = value; + } +} + + +LVAL xslider_read(void) +{ + LVAL arg = xlgafixnum(); + int index = getfixnum(arg); + xllastarg(); + if (index >= 0 && index < SLIDERS_MAX) { + return cvflonum(slider_array[index]); + } + return NIL; +} + +LVAL xosc_enable(void) +{ + LVAL arg = xlgetarg(); + xllastarg(); +#ifdef OSC + if (nosc_enabled == !null(arg)) { + return arg; /* no change */ + } else if (null(arg)) { /* nosc_enabled must be true */ + nosc_finish(); + return s_true; + } else { /* nosc_enabled must be false */ + nosc_init(); + return NIL; + } +#else + return xlenter("DISABLED"); +#endif +} + + +void slider_free(); + + +typedef struct slider_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + int index; +} slider_susp_node, *slider_susp_type; + + +void slider__fetch(register slider_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register sample_type c_reg; + int limit = ((long) susp->susp.sr) / 50; + falloc_sample_block(out, "slider__fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* compute no more than 20ms to preserve some interactivity */ + if (limit < 1) limit = 1; + if (limit > max_sample_block_len) limit = max_sample_block_len; + + while (cnt < limit) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block: */ + togo = limit - cnt; + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); + if (togo == 0) break; + } + + n = togo; + c_reg = slider_array[susp->index]; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + *out_ptr_reg++ = c_reg; + } while (--n); /* inner loop */ + + out_ptr += togo; + cnt += togo; + } /* outer loop */ + /* printf("slider %d cnt %d\n", susp->index, cnt); */ + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } +} /* slider__fetch */ + + +void slider_free(slider_susp_type susp) +{ + ffree_generic(susp, sizeof(slider_susp_node), "slider_free"); +} + + +void slider_print_tree(slider_susp_type susp, int n) +{ +} + + +sound_type snd_make_slider(int index, time_type t0, rate_type sr, time_type d) +{ + register slider_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + if (index < 0 || index >= SLIDERS_MAX) { + xlerror("slider index out of range", NIL); + } + falloc_generic(susp, slider_susp_node, "snd_make_slider"); + susp->susp.fetch = slider__fetch; + susp->index = index; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = slider_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = slider_print_tree; + susp->susp.name = "slider"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_slider(int index, time_type t0, rate_type sr, time_type d) +{ + return snd_make_slider(index, t0, sr, d); +} diff --git a/nyqsrc/sliders.h b/nyqsrc/sliders.h new file mode 100644 index 0000000..6628990 --- /dev/null +++ b/nyqsrc/sliders.h @@ -0,0 +1,11 @@ +/* sliders.h -- support for graphical sliders in Nyquist IDE */ + +/* probably these 3 should be elsewhere */ +int nosc_init(); +int nosc_poll(); +void nosc_finish(); + +#define SLIDERS_MAX 1024 +extern float slider_array[SLIDERS_MAX]; +void set_slider(int index, float value); + diff --git a/nyqsrc/sndfail.c b/nyqsrc/sndfail.c new file mode 100644 index 0000000..35b29cb --- /dev/null +++ b/nyqsrc/sndfail.c @@ -0,0 +1,23 @@ + +#include "stdio.h" +#include "snd.h" +#include "stdlib.h" +#include "xlisp.h" +#include "string.h" + +void snd_fail(char *msg) +{ + char *bigger = (char *) malloc(strlen(msg) + 16); + if (!bigger) xlfail("no memory"); + strcpy(bigger, "(snd)"); + strcat(bigger, msg); + xlfail(bigger); + // NOTE: there is a memory leak here +} + + +void snd_warn(char *msg) +{ + stdputstr(msg); + stdputstr("\n"); +} diff --git a/nyqsrc/sndfmt.h b/nyqsrc/sndfmt.h new file mode 100644 index 0000000..2434005 --- /dev/null +++ b/nyqsrc/sndfmt.h @@ -0,0 +1,118 @@ +/* + * sndfmt.h -- format constants for Nyquist programs + */ +/* + * converted by Roger Dannenberg from snd.h, Jul 08 + */ +#ifdef SND_H +error here +#endif +#define SND_H + + +/* header formats */ + +#define SND_HEAD_NONE 0 +/* LISP-SRC: (setf snd-head-none 0) */ +#define SND_HEAD_AIFF 1 +/* LISP-SRC: (setf snd-head-AIFF 1) */ +#define SND_HEAD_IRCAM 2 +/* LISP-SRC: (setf snd-head-IRCAM 2) */ +#define SND_HEAD_NEXT 3 +/* LISP-SRC: (setf snd-head-NeXT 3) */ +#define SND_HEAD_WAVE 4 +/* LISP-SRC: (setf snd-head-Wave 4) */ +#define SND_HEAD_PAF 5 +/* LISP-SRC: (setf snd-head-PAF 5) */ +#define SND_HEAD_SVX 6 +/* LISP-SRC: (setf snd-head-SVX 6) */ +#define SND_HEAD_NIST 7 +/* LISP-SRC: (setf snd-head-NIST 7) */ +#define SND_HEAD_VOC 8 +/* LISP-SRC: (setf snd-head-VOC 8) */ +#define SND_HEAD_W64 9 +/* LISP-SRC: (setf snd-head-W64 9) */ +#define SND_HEAD_MAT4 10 +/* LISP-SRC: (setf snd-head-MAT4 10) */ +#define SND_HEAD_MAT5 11 +/* LISP-SRC: (setf snd-head-MAT5 11) */ +#define SND_HEAD_PVF 12 +/* LISP-SRC: (setf snd-head-PVF 12) */ +#define SND_HEAD_XI 13 +/* LISP-SRC: (setf snd-head-XI 13) */ +#define SND_HEAD_HTK 14 +/* LISP-SRC: (setf snd-head-HTK 14) */ +#define SND_HEAD_SDS 15 +/* LISP-SRC: (setf snd-head-SDS 15) */ +#define SND_HEAD_AVR 16 +/* LISP-SRC: (setf snd-head-AVR 16) */ +#define SND_HEAD_SD2 17 +/* LISP-SRC: (setf snd-head-SD2 17) */ +#define SND_HEAD_FLAC 18 +/* LISP-SRC: (setf snd-head-FLAC 18) */ +#define SND_HEAD_CAF 19 +/* LISP-SRC: (setf snd-head-CAF 19) */ +#define SND_HEAD_RAW 20 +/* LISP-SRC: (setf snd-head-raw 20) */ +#define SND_NUM_HEADS 21 + +/* bitfields for soundheaders */ +#define SND_HEAD_CHANNELS (1<<0) +/* LISP-SRC: (setf snd-head-channels 1) */ +#define SND_HEAD_MODE (1<<1) +/* LISP-SRC: (setf snd-head-mode 2) */ +#define SND_HEAD_BITS (1<<2) +/* LISP-SRC: (setf snd-head-bits 4) */ +#define SND_HEAD_SRATE (1<<3) +/* LISP-SRC: (setf snd-head-srate 8) */ + +/* when returned from lisp, len (samples) is converted to time (seconds) */ +#define SND_HEAD_LEN (1<<4) +/* LISP-SRC: (setf snd-head-dur 16) */ + +#define SND_HEAD_LATENCY (1<<5) +/* LISP-SRC: (setf snd-head-latency 32) */ +#define SND_HEAD_TYPE (1<<6) +/* LISP-SRC: (setf snd-head-type 64) */ + +/* modes */ +/* IMA ADPCM */ +#define SND_MODE_ADPCM 0 +/* LISP-SRC: (setf snd-mode-adpcm 0) */ +#define SND_MODE_PCM 1 +/* LISP-SRC: (setf snd-mode-pcm 1) */ +#define SND_MODE_ULAW 2 +/* LISP-SRC: (setf snd-mode-ulaw 2) */ +#define SND_MODE_ALAW 3 +/* LISP-SRC: (setf snd-mode-alaw 3) */ +#define SND_MODE_FLOAT 4 +/* LISP-SRC: (setf snd-mode-float 4) */ +/* unsigned pcm (e.g. Microsoft 8-bit wav format): */ +#define SND_MODE_UPCM 5 +/* LISP-SRC: (setf snd-mode-upcm 5) */ +#define SND_MODE_UNKNOWN 6 +/* LISP-SRC: (setf snd-mode-unknown 6) */ +#define SND_MODE_DOUBLE 7 +/* LISP-SRC: (setf snd-mode-double 7) */ +#define SND_MODE_GSM610 8 +/* LISP-SRC: (setf snd-mode-GSM610 8) */ +#define SND_MODE_DWVW 9 +/* LISP-SRC: (setf snd-mode-DWVW 9) */ +#define SND_MODE_DPCM 10 +/* LISP-SRC: (setf snd-mode-DPCM 10) */ +/* microsoft ADPCM */ +#define SND_MODE_MSADPCM 11 +/* LISP-SRC: (setf snd-mode-msadpcm 11) */ +#define SND_NUM_MODES 12 + + +#define SND_LOOP_NONE 0 +#define SND_LOOP_FORWARD 1 +#define SND_LOOP_FORWARD_BACKWARD 2 + +typedef struct { + int mode; + long begin; + long end; +} loop_node, *loop_type; + diff --git a/nyqsrc/sndfn.cl b/nyqsrc/sndfn.cl new file mode 100644 index 0000000..80e4ef3 --- /dev/null +++ b/nyqsrc/sndfn.cl @@ -0,0 +1,54 @@ +nyqsrc/sndfnint snd/snd.h + nyqsrc/sound.h nyqsrc/add.h + nyqsrc/avg.h nyqsrc/compose.h + nyqsrc/convolve.h nyqsrc/downsample.h + nyqsrc/fft.h nyqsrc/inverse.h + nyqsrc/multiseq.h nyqsrc/resamp.h + nyqsrc/resampv.h nyqsrc/samples.h + nyqsrc/sndmax.h nyqsrc/sndread.h + nyqsrc/sndseq.h nyqsrc/sndsliders.h + nyqsrc/sndwrite.h nyqsrc/yin.h + nyqsrc/nyq-osc-server.h nyqsrc/trigger.h + nyqsrc/lpanal.h nyqsrc/phasevocoder.h + nyqsrc/pvshell.h ~nyqsrc/sndheader.h + tran/abs.h tran/allpoles.h + tran/alpass.h tran/alpasscv.h + tran/alpassvv.h tran/amosc.h + tran/areson.h tran/aresonvc.h + tran/aresoncv.h tran/aresonvv.h + tran/atone.h tran/atonev.h + tran/biquadfilt.h tran/buzz.h + tran/chase.h tran/clip.h + tran/congen.h tran/const.h + tran/coterm.h tran/delaycc.h + tran/delaycv.h tran/eqbandvvv.h + tran/exp.h tran/follow.h + tran/fmosc.h tran/fromobject.h + tran/fromarraystream.h tran/gate.h + tran/ifft.h tran/instrclar.h + tran/instrclarall.h tran/instrclarfreq.h + tran/instrsax.h tran/instrsaxall.h + tran/instrsaxfreq.h tran/integrate.h + tran/log.h tran/lpreson.h + tran/maxv.h tran/offset.h + tran/oneshot.h tran/osc.h + tran/partial.h tran/pluck.h + tran/prod.h tran/pwl.h + tran/quantize.h tran/recip.h + tran/reson.h tran/resonvc.h + tran/resoncv.h tran/resonvv.h + tran/sampler.h tran/scale.h + tran/shape.h tran/sine.h + tran/siosc.h tran/slope.h + tran/sqrt.h tran/tapf.h + tran/tapv.h tran/tone.h + tran/tonev.h tran/upsample.h + tran/white.h tran/stkrev.h + tran/stkpitshift.h tran/stkchorus.h + tran/instrbow.h tran/instrbowedfreq.h + tran/instrbanded.h tran/instrmandolin.h + tran/instrsitar.h tran/instrmodalbar.h + tran/instrflute.h tran/instrflutefreq.h + tran/instrfluteall.h tran/fmfb.h + tran/fmfbv.h + diff --git a/nyqsrc/sndfn.wcl b/nyqsrc/sndfn.wcl new file mode 100644 index 0000000..6b7d445 --- /dev/null +++ b/nyqsrc/sndfn.wcl @@ -0,0 +1,54 @@ +nyqsrc\sndfnint snd\snd.h + nyqsrc\sound.h nyqsrc\add.h + nyqsrc\avg.h nyqsrc\compose.h + nyqsrc\convolve.h nyqsrc\downsample.h + nyqsrc\fft.h nyqsrc\inverse.h + nyqsrc\multiseq.h nyqsrc\resamp.h + nyqsrc\resampv.h nyqsrc\samples.h + nyqsrc\sndmax.h nyqsrc\sndread.h + nyqsrc\sndseq.h nyqsrc\sndsliders.h + nyqsrc\sndwrite.h nyqsrc\yin.h + nyqsrc\nyq-osc-server.h nyqsrc\trigger.h + nyqsrc\lpanal.h nyqsrc\phasevocoder.h + nyqsrc\pvshell.h ~nyqsrc\sndheader.h + tran\abs.h tran\allpoles.h + tran\alpass.h tran\alpasscv.h + tran\alpassvv.h tran\amosc.h + tran\areson.h tran\aresonvc.h + tran\aresoncv.h tran\aresonvv.h + tran\atone.h tran\atonev.h + tran\biquadfilt.h tran\buzz.h + tran\chase.h tran\clip.h + tran\congen.h tran\const.h + tran\coterm.h tran\delaycc.h + tran\delaycv.h tran\eqbandvvv.h + tran\exp.h tran\follow.h + tran\fmosc.h tran\fromobject.h + tran\fromarraystream.h tran\gate.h + tran\ifft.h tran\instrclar.h + tran\instrclarall.h tran\instrclarfreq.h + tran\instrsax.h tran\instrsaxall.h + tran\instrsaxfreq.h tran\integrate.h + tran\log.h tran\lpreson.h + tran\maxv.h tran\offset.h + tran\oneshot.h tran\osc.h + tran\partial.h tran\pluck.h + tran\prod.h tran\pwl.h + tran\quantize.h tran\recip.h + tran\reson.h tran\resonvc.h + tran\resoncv.h tran\resonvv.h + tran\sampler.h tran\scale.h + tran\shape.h tran\sine.h + tran\siosc.h tran\slope.h + tran\sqrt.h tran\tapf.h + tran\tapv.h tran\tone.h + tran\tonev.h tran\upsample.h + tran\white.h tran\stkrev.h + tran\stkpitshift.h tran\stkchorus.h + tran\instrbow.h tran\instrbowedfreq.h + tran\instrbanded.h tran\instrmandolin.h + tran\instrsitar.h tran\instrmodalbar.h + tran\instrflute.h tran\instrflutefreq.h + tran\instrfluteall.h tran\fmfb.h + tran\fmfbv.h + diff --git a/nyqsrc/sndfnint.c b/nyqsrc/sndfnint.c new file mode 100644 index 0000000..4cb5bfe --- /dev/null +++ b/nyqsrc/sndfnint.c @@ -0,0 +1,2232 @@ +/* nyqsrc/sndfnint.c -- interface to nyqsrc/sndfmt.h, + * nylsf/sndfile.h, nyqsrc/sound.h, nyqsrc/add.h, + * nyqsrc/avg.h, nyqsrc/compose.h, nyqsrc/convolve.h, + * nyqsrc/downsample.h, nyqsrc/fft.h, nyqsrc/inverse.h, + * nyqsrc/multiseq.h, nyqsrc/resamp.h, nyqsrc/resampv.h, + * nyqsrc/samples.h, nyqsrc/sndmax.h, nyqsrc/sndread.h, + * nyqsrc/sndseq.h, nyqsrc/sndsliders.h, nyqsrc/sndwrite.h, + * nyqsrc/yin.h, nyqsrc/nyq-osc-server.h, nyqsrc/trigger.h, + * nyqsrc/lpanal.h, nyqsrc/phasevocoder.h, + * nyqsrc/pvshell.h, tran/abs.h, tran/allpoles.h, + * tran/alpass.h, tran/alpasscv.h, tran/alpassvv.h, + * tran/amosc.h, tran/areson.h, tran/aresonvc.h, + * tran/aresoncv.h, tran/aresonvv.h, tran/atone.h, + * tran/atonev.h, tran/biquadfilt.h, tran/buzz.h, + * tran/chase.h, tran/clip.h, tran/congen.h, + * tran/const.h, tran/coterm.h, tran/delaycc.h, + * tran/delaycv.h, tran/eqbandvvv.h, tran/exp.h, + * tran/follow.h, tran/fmosc.h, tran/fromobject.h, + * tran/fromarraystream.h, tran/gate.h, tran/ifft.h, + * tran/instrclar.h, tran/instrclarall.h, + * tran/instrclarfreq.h, tran/instrsax.h, + * tran/instrsaxall.h, tran/instrsaxfreq.h, + * tran/integrate.h, tran/log.h, tran/lpreson.h, + * tran/maxv.h, tran/offset.h, tran/oneshot.h, + * tran/osc.h, tran/partial.h, tran/pluck.h, tran/prod.h, + * tran/pwl.h, tran/quantize.h, tran/recip.h, + * tran/reson.h, tran/resonvc.h, tran/resoncv.h, + * tran/resonvv.h, tran/sampler.h, tran/scale.h, + * tran/shape.h, tran/sine.h, tran/siosc.h, tran/slope.h, + * tran/sqrt.h, tran/tapf.h, tran/tapv.h, tran/tone.h, + * tran/tonev.h, tran/upsample.h, tran/white.h, + * tran/stkrev.h, tran/stkpitshift.h, tran/stkchorus.h, + * tran/instrbow.h, tran/instrbowedfreq.h, + * tran/instrbanded.h, tran/instrmandolin.h, + * tran/instrsitar.h, tran/instrmodalbar.h, + * tran/instrflute.h, tran/instrflutefreq.h, + * tran/instrfluteall.h, tran/fmfb.h, tran/fmfbv.h */ + +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" + +extern LVAL s_true; +#define cvboolean(i) ((i) ? s_true : NIL) +#define testarg2(e) (moreargs() ? (e) : (getflonum(xltoofew()))) +#define xlgaanynum() (floatp(*xlargv) ? getflonum(nextarg()) : \ + (fixp(*xlargv) ? (double) getfixnum(nextarg()) : \ + getflonum(xlbadtype(*xlargv)))) +#define getboolean(lval) ((lval) != NIL) + +extern LVAL RSLT_sym; + + +#include "sndfmt.h" + +#include "sndfile.h" + +#include "sound.h" + +/* xlc_snd_set_latency -- interface to C routine snd_set_latency */ +/**/ +LVAL xlc_snd_set_latency(void) +{ + double arg1 = getflonum(xlgaflonum()); + double result; + + xllastarg(); + result = snd_set_latency(arg1); + return cvflonum(result); +} + + +/* xlc_soundp -- interface to C routine soundp */ +/**/ +LVAL xlc_soundp(void) +{ + LVAL arg1 = xlgetarg(); + boolean result; + + xllastarg(); + result = soundp(arg1); + return cvboolean(result); +} + + +/* xlc_hz_to_step -- interface to C routine hz_to_step */ +/**/ +LVAL xlc_hz_to_step(void) +{ + double arg1 = testarg2(xlgaanynum()); + double result; + + xllastarg(); + result = hz_to_step(arg1); + return cvflonum(result); +} + + +/* xlc_snd_set_logical_stop -- interface to C routine set_logical_stop_time */ +/**/ +LVAL xlc_snd_set_logical_stop(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + + xllastarg(); + set_logical_stop_time(arg1, arg2); + return NIL; +} + + +/* xlc_log -- interface to C routine xlog */ +/**/ +LVAL xlc_log(void) +{ + double arg1 = getflonum(xlgaflonum()); + double result; + + xllastarg(); + result = xlog(arg1); + return cvflonum(result); +} + + +/* xlc_snd_sref -- interface to C routine snd_sref */ +/**/ +LVAL xlc_snd_sref(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double result; + + xllastarg(); + result = snd_sref(arg1, arg2); + return cvflonum(result); +} + + +/* xlc_sref_inverse -- interface to C routine snd_sref_inverse */ +/**/ +LVAL xlc_sref_inverse(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double result; + + xllastarg(); + result = snd_sref_inverse(arg1, arg2); + return cvflonum(result); +} + + +/* xlc_snd_stop_time -- interface to C routine snd_stop_time */ +/**/ +LVAL xlc_snd_stop_time(void) +{ + sound_type arg1 = getsound(xlgasound()); + double result; + + xllastarg(); + result = snd_stop_time(arg1); + return cvflonum(result); +} + + +/* xlc_snd_time -- interface to C routine snd_time */ +/**/ +LVAL xlc_snd_time(void) +{ + sound_type arg1 = getsound(xlgasound()); + double result; + + xllastarg(); + result = snd_time(arg1); + return cvflonum(result); +} + + +/* xlc_snd_srate -- interface to C routine snd_srate */ +/**/ +LVAL xlc_snd_srate(void) +{ + sound_type arg1 = getsound(xlgasound()); + double result; + + xllastarg(); + result = snd_srate(arg1); + return cvflonum(result); +} + + +/* xlc_snd_t0 -- interface to C routine snd_t0 */ +/**/ +LVAL xlc_snd_t0(void) +{ + sound_type arg1 = getsound(xlgasound()); + double result; + + xllastarg(); + result = snd_t0(arg1); + return cvflonum(result); +} + + +/* xlc_snd_xform -- interface to C routine snd_xform */ +/**/ +LVAL xlc_snd_xform(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + double arg6 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_xform(arg1, arg2, arg3, arg4, arg5, arg6); + return cvsound(result); +} + + +/* xlc_block_watch -- interface to C routine block_watch */ +/**/ +LVAL xlc_block_watch(void) +{ + long arg1 = getfixnum(xlgafixnum()); + + xllastarg(); + block_watch(arg1); + return NIL; +} + + +/* xlc_sound_nth_block -- interface to C routine sound_nth_block */ +/**/ +LVAL xlc_sound_nth_block(void) +{ + sound_type arg1 = getsound(xlgasound()); + long arg2 = getfixnum(xlgafixnum()); + long result; + + xllastarg(); + result = sound_nth_block(arg1, arg2); + return cvfixnum(result); +} + + +/* xlc_snd_copy -- interface to C routine sound_copy */ +/**/ +LVAL xlc_snd_copy(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = sound_copy(arg1); + return cvsound(result); +} + + +/* xlc_snd_print -- interface to C routine sound_print */ +/**/ +LVAL xlc_snd_print(void) +{ + LVAL arg1 = xlgetarg(); + long arg2 = getfixnum(xlgafixnum()); + + xllastarg(); + sound_print(arg1, arg2); + return NIL; +} + + +/* xlc_snd_play -- interface to C routine sound_play */ +/**/ +LVAL xlc_snd_play(void) +{ + LVAL arg1 = xlgetarg(); + + xllastarg(); + sound_play(arg1); + return NIL; +} + + +/* xlc_stats -- interface to C routine stats */ +/**/ +LVAL xlc_stats(void) +{ + + xllastarg(); + stats(); + return NIL; +} + + +/* xlc_snd_print_tree -- interface to C routine sound_print_tree */ +/**/ +LVAL xlc_snd_print_tree(void) +{ + sound_type arg1 = getsound(xlgasound()); + + xllastarg(); + sound_print_tree(arg1); + return NIL; +} + + +/* xlc_snd_scale -- interface to C routine sound_scale */ +/**/ +LVAL xlc_snd_scale(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = sound_scale(arg1, arg2); + return cvsound(result); +} + + +/* xlc_snd_zero -- interface to C routine sound_zero */ +/**/ +LVAL xlc_snd_zero(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = sound_zero(arg1, arg2); + return cvsound(result); +} + + +/* xlc_step_to_hz -- interface to C routine step_to_hz */ +/**/ +LVAL xlc_step_to_hz(void) +{ + double arg1 = testarg2(xlgaanynum()); + double result; + + xllastarg(); + result = step_to_hz(arg1); + return cvflonum(result); +} + + +#include "add.h" + +/* xlc_snd_add -- interface to C routine snd_add */ +/**/ +LVAL xlc_snd_add(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_add(arg1, arg2); + return cvsound(result); +} + + +#include "avg.h" + +/* xlc_snd_avg -- interface to C routine snd_avg */ +/**/ +LVAL xlc_snd_avg(void) +{ + sound_type arg1 = getsound(xlgasound()); + long arg2 = getfixnum(xlgafixnum()); + long arg3 = getfixnum(xlgafixnum()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_avg(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "compose.h" + +/* xlc_snd_compose -- interface to C routine snd_compose */ +/**/ +LVAL xlc_snd_compose(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_compose(arg1, arg2); + return cvsound(result); +} + + +#include "convolve.h" + +/* xlc_snd_convolve -- interface to C routine snd_convolve */ +/**/ +LVAL xlc_snd_convolve(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_convolve(arg1, arg2); + return cvsound(result); +} + + +#include "downsample.h" + +/* xlc_snd_down -- interface to C routine snd_down */ +/**/ +LVAL xlc_snd_down(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_down(arg1, arg2); + return cvsound(result); +} + + +#include "fft.h" + +/* xlc_snd_fft -- interface to C routine snd_fft */ +/**/ +LVAL xlc_snd_fft(void) +{ + sound_type arg1 = getsound(xlgasound()); + long arg2 = getfixnum(xlgafixnum()); + long arg3 = getfixnum(xlgafixnum()); + LVAL arg4 = xlgetarg(); + LVAL result; + + xllastarg(); + result = snd_fft(arg1, arg2, arg3, arg4); + return (result); +} + + +#include "inverse.h" + +/* xlc_snd_inverse -- interface to C routine snd_inverse */ +/**/ +LVAL xlc_snd_inverse(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_inverse(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "multiseq.h" + +/* xlc_snd_multiseq -- interface to C routine snd_make_multiseq */ +/**/ +LVAL xlc_snd_multiseq(void) +{ + LVAL arg1 = xlgetarg(); + LVAL arg2 = xlgetarg(); + LVAL result; + + xllastarg(); + result = snd_make_multiseq(arg1, arg2); + return (result); +} + + +#include "resamp.h" + +/* xlc_snd_resample -- interface to C routine snd_resample */ +/**/ +LVAL xlc_snd_resample(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_resample(arg1, arg2); + return cvsound(result); +} + + +#include "resampv.h" + +/* xlc_snd_resamplev -- interface to C routine snd_resamplev */ +/**/ +LVAL xlc_snd_resamplev(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_resamplev(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "samples.h" + +/* xlc_snd_from_array -- interface to C routine snd_from_array */ +/**/ +LVAL xlc_snd_from_array(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + LVAL arg3 = xlgetarg(); + sound_type result; + + xllastarg(); + result = snd_from_array(arg1, arg2, arg3); + return cvsound(result); +} + + +/* xlc_snd_samples -- interface to C routine snd_samples */ +/**/ +LVAL xlc_snd_samples(void) +{ + sound_type arg1 = getsound(xlgasound()); + long arg2 = getfixnum(xlgafixnum()); + LVAL result; + + xllastarg(); + result = snd_samples(arg1, arg2); + return (result); +} + + +/* xlc_snd_length -- interface to C routine snd_length */ +/**/ +LVAL xlc_snd_length(void) +{ + sound_type arg1 = getsound(xlgasound()); + long arg2 = getfixnum(xlgafixnum()); + long result; + + xllastarg(); + result = snd_length(arg1, arg2); + return cvfixnum(result); +} + + +/* xlc_snd_maxsamp -- interface to C routine snd_maxsamp */ +/**/ +LVAL xlc_snd_maxsamp(void) +{ + sound_type arg1 = getsound(xlgasound()); + double result; + + xllastarg(); + result = snd_maxsamp(arg1); + return cvflonum(result); +} + + +/* xlc_snd_fetch -- interface to C routine snd_fetch */ +/**/ +LVAL xlc_snd_fetch(void) +{ + sound_type arg1 = getsound(xlgasound()); + LVAL result; + + xllastarg(); + result = snd_fetch(arg1); + return (result); +} + + +/* xlc_snd_fetch_array -- interface to C routine snd_fetch_array */ +/**/ +LVAL xlc_snd_fetch_array(void) +{ + sound_type arg1 = getsound(xlgasound()); + long arg2 = getfixnum(xlgafixnum()); + long arg3 = getfixnum(xlgafixnum()); + LVAL result; + + xllastarg(); + result = snd_fetch_array(arg1, arg2, arg3); + return (result); +} + + +#include "sndmax.h" + +/* xlc_snd_max -- interface to C routine sound_max */ +/**/ +LVAL xlc_snd_max(void) +{ + LVAL arg1 = xlgetarg(); + long arg2 = getfixnum(xlgafixnum()); + double result; + + xllastarg(); + result = sound_max(arg1, arg2); + return cvflonum(result); +} + + +#include "sndread.h" + +/* xlc_snd_read -- interface to C routine snd_make_read */ +/**/ +LVAL xlc_snd_read(void) +{ + unsigned char * arg1 = getstring(xlgastring()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + long arg4 = getfixnum(xlgafixnum()); + long arg5 = getfixnum(xlgafixnum()); + long arg6 = getfixnum(xlgafixnum()); + long arg7 = getfixnum(xlgafixnum()); + long arg8 = getfixnum(xlgafixnum()); + double arg9 = testarg2(xlgaanynum()); + double arg10 = testarg2(xlgaanynum()); + long arg11 = 0; + long arg12 = 0; + LVAL result; + + xllastarg(); + xlprot1(result); + result = snd_make_read(arg1, arg2, arg3, &arg4, &arg5, &arg6, &arg7, &arg8, &arg9, &arg10, &arg11, &arg12); + { LVAL *next = &getvalue(RSLT_sym); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg4); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg5); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg6); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg7); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg8); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvflonum(arg9); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvflonum(arg10); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg11); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg12); + } + xlpop(); + return (result); +} + + +#include "sndseq.h" + +/* xlc_snd_seq -- interface to C routine snd_sndseq */ +/**/ +LVAL xlc_snd_seq(void) +{ + sound_type arg1 = getsound(xlgasound()); + LVAL arg2 = xlgetarg(); + sound_type result; + + xllastarg(); + result = snd_sndseq(arg1, arg2); + return cvsound(result); +} + + +#include "sndsliders.h" + +/* xlc_snd_slider -- interface to C routine snd_slider */ +/**/ +LVAL xlc_snd_slider(void) +{ + long arg1 = getfixnum(xlgafixnum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_slider(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "sndwrite.h" + +/* xlc_snd_save -- interface to C routine sound_save */ +/**/ +LVAL xlc_snd_save(void) +{ + LVAL arg1 = xlgetarg(); + long arg2 = getfixnum(xlgafixnum()); + unsigned char * arg3 = getstring(xlgastring()); + long arg4 = getfixnum(xlgafixnum()); + long arg5 = getfixnum(xlgafixnum()); + long arg6 = getfixnum(xlgafixnum()); + long arg7 = getfixnum(xlgafixnum()); + double arg8 = 0.0; + long arg9 = 0; + double arg10 = 0.0; + LVAL arg11 = xlgetarg(); + double result; + + xllastarg(); + result = sound_save(arg1, arg2, arg3, arg4, arg5, arg6, arg7, &arg8, &arg9, &arg10, arg11); + { LVAL *next = &getvalue(RSLT_sym); + *next = cons(NIL, NIL); + car(*next) = cvflonum(arg8); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvfixnum(arg9); next = &cdr(*next); + *next = cons(NIL, NIL); + car(*next) = cvflonum(arg10); + } + return cvflonum(result); +} + + +/* xlc_snd_overwrite -- interface to C routine sound_overwrite */ +/**/ +LVAL xlc_snd_overwrite(void) +{ + LVAL arg1 = xlgetarg(); + long arg2 = getfixnum(xlgafixnum()); + unsigned char * arg3 = getstring(xlgastring()); + double arg4 = testarg2(xlgaanynum()); + long arg5 = getfixnum(xlgafixnum()); + long arg6 = getfixnum(xlgafixnum()); + long arg7 = getfixnum(xlgafixnum()); + long arg8 = getfixnum(xlgafixnum()); + double arg9 = 0.0; + double result; + + xllastarg(); + result = sound_overwrite(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, &arg9); + { LVAL *next = &getvalue(RSLT_sym); + *next = cons(NIL, NIL); + car(*next) = cvflonum(arg9); + } + return cvflonum(result); +} + + +#include "yin.h" + +/* xlc_snd_yin -- interface to C routine snd_yin */ +/**/ +LVAL xlc_snd_yin(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + long arg4 = getfixnum(xlgafixnum()); + LVAL result; + + xllastarg(); + result = snd_yin(arg1, arg2, arg3, arg4); + return (result); +} + + +#include "nyq-osc-server.h" + +#include "trigger.h" + +/* xlc_snd_trigger -- interface to C routine snd_trigger */ +/**/ +LVAL xlc_snd_trigger(void) +{ + sound_type arg1 = getsound(xlgasound()); + LVAL arg2 = xlgetarg(); + sound_type result; + + xllastarg(); + result = snd_trigger(arg1, arg2); + return cvsound(result); +} + + +#include "lpanal.h" + +/* xlc_snd_lpanal -- interface to C routine snd_lpanal */ +/**/ +LVAL xlc_snd_lpanal(void) +{ + LVAL arg1 = xlgetarg(); + long arg2 = getfixnum(xlgafixnum()); + LVAL result; + + xllastarg(); + result = snd_lpanal(arg1, arg2); + return (result); +} + + +#include "phasevocoder.h" + +/* xlc_snd_phasevocoder -- interface to C routine snd_phasevocoder */ +/**/ +LVAL xlc_snd_phasevocoder(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_phasevocoder(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "pvshell.h" + +#include "abs.h" + +/* xlc_snd_abs -- interface to C routine snd_abs */ +/**/ +LVAL xlc_snd_abs(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_abs(arg1); + return cvsound(result); +} + + +#include "allpoles.h" + +/* xlc_snd_allpoles -- interface to C routine snd_allpoles */ +/**/ +LVAL xlc_snd_allpoles(void) +{ + sound_type arg1 = getsound(xlgasound()); + LVAL arg2 = xlgetarg(); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_allpoles(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "alpass.h" + +/* xlc_snd_alpass -- interface to C routine snd_alpass */ +/**/ +LVAL xlc_snd_alpass(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_alpass(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "alpasscv.h" + +/* xlc_snd_alpasscv -- interface to C routine snd_alpasscv */ +/**/ +LVAL xlc_snd_alpasscv(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_alpasscv(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "alpassvv.h" + +/* xlc_snd_alpassvv -- interface to C routine snd_alpassvv */ +/**/ +LVAL xlc_snd_alpassvv(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_alpassvv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "amosc.h" + +/* xlc_snd_amosc -- interface to C routine snd_amosc */ +/**/ +LVAL xlc_snd_amosc(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type arg6 = getsound(xlgasound()); + double arg7 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_amosc(arg1, arg2, arg3, arg4, arg5, arg6, arg7); + return cvsound(result); +} + + +#include "areson.h" + +/* xlc_snd_areson -- interface to C routine snd_areson */ +/**/ +LVAL xlc_snd_areson(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_areson(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "aresonvc.h" + +/* xlc_snd_aresonvc -- interface to C routine snd_aresonvc */ +/**/ +LVAL xlc_snd_aresonvc(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_aresonvc(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "aresoncv.h" + +/* xlc_snd_aresoncv -- interface to C routine snd_aresoncv */ +/**/ +LVAL xlc_snd_aresoncv(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_aresoncv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "aresonvv.h" + +/* xlc_snd_aresonvv -- interface to C routine snd_aresonvv */ +/**/ +LVAL xlc_snd_aresonvv(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_aresonvv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "atone.h" + +/* xlc_snd_atone -- interface to C routine snd_atone */ +/**/ +LVAL xlc_snd_atone(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_atone(arg1, arg2); + return cvsound(result); +} + + +#include "atonev.h" + +/* xlc_snd_atonev -- interface to C routine snd_atonev */ +/**/ +LVAL xlc_snd_atonev(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_atonev(arg1, arg2); + return cvsound(result); +} + + +#include "biquadfilt.h" + +/* xlc_snd_biquad -- interface to C routine snd_biquadfilt */ +/**/ +LVAL xlc_snd_biquad(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + double arg6 = testarg2(xlgaanynum()); + double arg7 = testarg2(xlgaanynum()); + double arg8 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_biquadfilt(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); + return cvsound(result); +} + + +#include "buzz.h" + +/* xlc_snd_buzz -- interface to C routine snd_buzz */ +/**/ +LVAL xlc_snd_buzz(void) +{ + long arg1 = getfixnum(xlgafixnum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + sound_type arg5 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_buzz(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "chase.h" + +/* xlc_snd_chase -- interface to C routine snd_chase */ +/**/ +LVAL xlc_snd_chase(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_chase(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "clip.h" + +/* xlc_snd_clip -- interface to C routine snd_clip */ +/**/ +LVAL xlc_snd_clip(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_clip(arg1, arg2); + return cvsound(result); +} + + +#include "congen.h" + +/* xlc_snd_congen -- interface to C routine snd_congen */ +/**/ +LVAL xlc_snd_congen(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_congen(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "const.h" + +/* xlc_snd_const -- interface to C routine snd_const */ +/**/ +LVAL xlc_snd_const(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_const(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "coterm.h" + +/* xlc_snd_coterm -- interface to C routine snd_coterm */ +/**/ +LVAL xlc_snd_coterm(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_coterm(arg1, arg2); + return cvsound(result); +} + + +#include "delaycc.h" + +/* xlc_snd_delay -- interface to C routine snd_delay */ +/**/ +LVAL xlc_snd_delay(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_delay(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "delaycv.h" + +/* xlc_snd_delaycv -- interface to C routine snd_delaycv */ +/**/ +LVAL xlc_snd_delaycv(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_delaycv(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "eqbandvvv.h" + +/* xlc_snd_eqbandvvv -- interface to C routine snd_eqbandvvv */ +/**/ +LVAL xlc_snd_eqbandvvv(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + sound_type arg4 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_eqbandvvv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "exp.h" + +/* xlc_snd_exp -- interface to C routine snd_exp */ +/**/ +LVAL xlc_snd_exp(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_exp(arg1); + return cvsound(result); +} + + +#include "follow.h" + +/* xlc_snd_follow -- interface to C routine snd_follow */ +/**/ +LVAL xlc_snd_follow(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + long arg5 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_follow(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "fmosc.h" + +/* xlc_snd_fmosc -- interface to C routine snd_fmosc */ +/**/ +LVAL xlc_snd_fmosc(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type arg6 = getsound(xlgasound()); + double arg7 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_fmosc(arg1, arg2, arg3, arg4, arg5, arg6, arg7); + return cvsound(result); +} + + +#include "fromobject.h" + +/* xlc_snd_fromobject -- interface to C routine snd_fromobject */ +/**/ +LVAL xlc_snd_fromobject(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + LVAL arg3 = xlgetarg(); + sound_type result; + + xllastarg(); + result = snd_fromobject(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "fromarraystream.h" + +/* xlc_snd_fromarraystream -- interface to C routine snd_fromarraystream */ +/**/ +LVAL xlc_snd_fromarraystream(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + LVAL arg3 = xlgetarg(); + sound_type result; + + xllastarg(); + result = snd_fromarraystream(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "gate.h" + +/* xlc_snd_gate -- interface to C routine snd_gate */ +/**/ +LVAL xlc_snd_gate(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + double arg6 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_gate(arg1, arg2, arg3, arg4, arg5, arg6); + return cvsound(result); +} + + +#include "ifft.h" + +/* xlc_snd_ifft -- interface to C routine snd_ifft */ +/**/ +LVAL xlc_snd_ifft(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + LVAL arg3 = xlgetarg(); + long arg4 = getfixnum(xlgafixnum()); + LVAL arg5 = xlgetarg(); + sound_type result; + + xllastarg(); + result = snd_ifft(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "instrclar.h" + +/* xlc_snd_clarinet -- interface to C routine snd_clarinet */ +/**/ +LVAL xlc_snd_clarinet(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_clarinet(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "instrclarall.h" + +/* xlc_snd_clarinet_all -- interface to C routine snd_clarinet_all */ +/**/ +LVAL xlc_snd_clarinet_all(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type arg6 = getsound(xlgasound()); + sound_type arg7 = getsound(xlgasound()); + double arg8 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_clarinet_all(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); + return cvsound(result); +} + + +#include "instrclarfreq.h" + +/* xlc_snd_clarinet_freq -- interface to C routine snd_clarinet_freq */ +/**/ +LVAL xlc_snd_clarinet_freq(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_clarinet_freq(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "instrsax.h" + +/* xlc_snd_sax -- interface to C routine snd_sax */ +/**/ +LVAL xlc_snd_sax(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_sax(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "instrsaxall.h" + +/* xlc_snd_sax_all -- interface to C routine snd_sax_all */ +/**/ +LVAL xlc_snd_sax_all(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type arg6 = getsound(xlgasound()); + sound_type arg7 = getsound(xlgasound()); + sound_type arg8 = getsound(xlgasound()); + sound_type arg9 = getsound(xlgasound()); + double arg10 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_sax_all(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10); + return cvsound(result); +} + + +#include "instrsaxfreq.h" + +/* xlc_snd_sax_freq -- interface to C routine snd_sax_freq */ +/**/ +LVAL xlc_snd_sax_freq(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_sax_freq(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "integrate.h" + +/* xlc_snd_integrate -- interface to C routine snd_integrate */ +/**/ +LVAL xlc_snd_integrate(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_integrate(arg1); + return cvsound(result); +} + + +#include "log.h" + +/* xlc_snd_log -- interface to C routine snd_log */ +/**/ +LVAL xlc_snd_log(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_log(arg1); + return cvsound(result); +} + + +#include "lpreson.h" + +/* xlc_snd_lpreson -- interface to C routine snd_lpreson */ +/**/ +LVAL xlc_snd_lpreson(void) +{ + sound_type arg1 = getsound(xlgasound()); + LVAL arg2 = xlgetarg(); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_lpreson(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "maxv.h" + +/* xlc_snd_maxv -- interface to C routine snd_maxv */ +/**/ +LVAL xlc_snd_maxv(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_maxv(arg1, arg2); + return cvsound(result); +} + + +#include "offset.h" + +/* xlc_snd_offset -- interface to C routine snd_offset */ +/**/ +LVAL xlc_snd_offset(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_offset(arg1, arg2); + return cvsound(result); +} + + +#include "oneshot.h" + +/* xlc_snd_oneshot -- interface to C routine snd_oneshot */ +/**/ +LVAL xlc_snd_oneshot(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_oneshot(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "osc.h" + +/* xlc_snd_osc -- interface to C routine snd_osc */ +/**/ +LVAL xlc_snd_osc(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + double arg6 = testarg2(xlgaanynum()); + double arg7 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_osc(arg1, arg2, arg3, arg4, arg5, arg6, arg7); + return cvsound(result); +} + + +#include "partial.h" + +/* xlc_snd_partial -- interface to C routine snd_partial */ +/**/ +LVAL xlc_snd_partial(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_partial(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "pluck.h" + +/* xlc_snd_pluck -- interface to C routine snd_pluck */ +/**/ +LVAL xlc_snd_pluck(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_pluck(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "prod.h" + +/* xlc_snd_prod -- interface to C routine snd_prod */ +/**/ +LVAL xlc_snd_prod(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_prod(arg1, arg2); + return cvsound(result); +} + + +#include "pwl.h" + +/* xlc_snd_pwl -- interface to C routine snd_pwl */ +/**/ +LVAL xlc_snd_pwl(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + LVAL arg3 = xlgetarg(); + sound_type result; + + xllastarg(); + result = snd_pwl(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "quantize.h" + +/* xlc_snd_quantize -- interface to C routine snd_quantize */ +/**/ +LVAL xlc_snd_quantize(void) +{ + sound_type arg1 = getsound(xlgasound()); + long arg2 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_quantize(arg1, arg2); + return cvsound(result); +} + + +#include "recip.h" + +/* xlc_snd_recip -- interface to C routine snd_recip */ +/**/ +LVAL xlc_snd_recip(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_recip(arg1); + return cvsound(result); +} + + +#include "reson.h" + +/* xlc_snd_reson -- interface to C routine snd_reson */ +/**/ +LVAL xlc_snd_reson(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_reson(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "resonvc.h" + +/* xlc_snd_resonvc -- interface to C routine snd_resonvc */ +/**/ +LVAL xlc_snd_resonvc(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_resonvc(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "resoncv.h" + +/* xlc_snd_resoncv -- interface to C routine snd_resoncv */ +/**/ +LVAL xlc_snd_resoncv(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_resoncv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "resonvv.h" + +/* xlc_snd_resonvv -- interface to C routine snd_resonvv */ +/**/ +LVAL xlc_snd_resonvv(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + long arg4 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_resonvv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "sampler.h" + +/* xlc_snd_sampler -- interface to C routine snd_sampler */ +/**/ +LVAL xlc_snd_sampler(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + double arg6 = testarg2(xlgaanynum()); + sound_type arg7 = getsound(xlgasound()); + long arg8 = getfixnum(xlgafixnum()); + sound_type result; + + xllastarg(); + result = snd_sampler(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); + return cvsound(result); +} + + +#include "scale.h" + +/* xlc_snd_normalize -- interface to C routine snd_normalize */ +/**/ +LVAL xlc_snd_normalize(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_normalize(arg1); + return cvsound(result); +} + + +#include "shape.h" + +/* xlc_snd_shape -- interface to C routine snd_shape */ +/**/ +LVAL xlc_snd_shape(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_shape(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "sine.h" + +/* xlc_snd_sine -- interface to C routine snd_sine */ +/**/ +LVAL xlc_snd_sine(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_sine(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "siosc.h" + +/* xlc_snd_siosc -- interface to C routine snd_siosc */ +/**/ +LVAL xlc_snd_siosc(void) +{ + LVAL arg1 = xlgetarg(); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + sound_type arg5 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_siosc(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "slope.h" + +/* xlc_snd_slope -- interface to C routine snd_slope */ +/**/ +LVAL xlc_snd_slope(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_slope(arg1); + return cvsound(result); +} + + +#include "sqrt.h" + +/* xlc_snd_sqrt -- interface to C routine snd_sqrt */ +/**/ +LVAL xlc_snd_sqrt(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_sqrt(arg1); + return cvsound(result); +} + + +#include "tapf.h" + +/* xlc_snd_tapf -- interface to C routine snd_tapf */ +/**/ +LVAL xlc_snd_tapf(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_tapf(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "tapv.h" + +/* xlc_snd_tapv -- interface to C routine snd_tapv */ +/**/ +LVAL xlc_snd_tapv(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_tapv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "tone.h" + +/* xlc_snd_tone -- interface to C routine snd_tone */ +/**/ +LVAL xlc_snd_tone(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_tone(arg1, arg2); + return cvsound(result); +} + + +#include "tonev.h" + +/* xlc_snd_tonev -- interface to C routine snd_tonev */ +/**/ +LVAL xlc_snd_tonev(void) +{ + sound_type arg1 = getsound(xlgasound()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_tonev(arg1, arg2); + return cvsound(result); +} + + +#include "upsample.h" + +/* xlc_snd_up -- interface to C routine snd_up */ +/**/ +LVAL xlc_snd_up(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_up(arg1, arg2); + return cvsound(result); +} + + +#include "white.h" + +/* xlc_snd_white -- interface to C routine snd_white */ +/**/ +LVAL xlc_snd_white(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_white(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "stkrev.h" + +/* xlc_snd_stkrev -- interface to C routine snd_stkrev */ +/**/ +LVAL xlc_snd_stkrev(void) +{ + long arg1 = getfixnum(xlgafixnum()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_stkrev(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "stkpitshift.h" + +/* xlc_snd_stkpitshift -- interface to C routine snd_stkpitshift */ +/**/ +LVAL xlc_snd_stkpitshift(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_stkpitshift(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "stkchorus.h" + +/* xlc_snd_stkchorus -- interface to C routine snd_stkchorus */ +/**/ +LVAL xlc_snd_stkchorus(void) +{ + sound_type arg1 = getsound(xlgasound()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + double arg6 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_stkchorus(arg1, arg2, arg3, arg4, arg5, arg6); + return cvsound(result); +} + + +#include "instrbow.h" + +/* xlc_snd_bowed -- interface to C routine snd_bowed */ +/**/ +LVAL xlc_snd_bowed(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_bowed(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "instrbowedfreq.h" + +/* xlc_snd_bowed_freq -- interface to C routine snd_bowed_freq */ +/**/ +LVAL xlc_snd_bowed_freq(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_bowed_freq(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "instrbanded.h" + +/* xlc_snd_bandedwg -- interface to C routine snd_bandedwg */ +/**/ +LVAL xlc_snd_bandedwg(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + long arg3 = getfixnum(xlgafixnum()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_bandedwg(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "instrmandolin.h" + +/* xlc_snd_mandolin -- interface to C routine snd_mandolin */ +/**/ +LVAL xlc_snd_mandolin(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + double arg6 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_mandolin(arg1, arg2, arg3, arg4, arg5, arg6); + return cvsound(result); +} + + +#include "instrsitar.h" + +/* xlc_snd_sitar -- interface to C routine snd_sitar */ +/**/ +LVAL xlc_snd_sitar(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_sitar(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "instrmodalbar.h" + +/* xlc_snd_modalbar -- interface to C routine snd_modalbar */ +/**/ +LVAL xlc_snd_modalbar(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + long arg3 = getfixnum(xlgafixnum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_modalbar(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "instrflute.h" + +/* xlc_snd_flute -- interface to C routine snd_flute */ +/**/ +LVAL xlc_snd_flute(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + double arg3 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_flute(arg1, arg2, arg3); + return cvsound(result); +} + + +#include "instrflutefreq.h" + +/* xlc_snd_flute_freq -- interface to C routine snd_flute_freq */ +/**/ +LVAL xlc_snd_flute_freq(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_flute_freq(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + +#include "instrfluteall.h" + +/* xlc_snd_flute_all -- interface to C routine snd_flute_all */ +/**/ +LVAL xlc_snd_flute_all(void) +{ + double arg1 = testarg2(xlgaanynum()); + sound_type arg2 = getsound(xlgasound()); + sound_type arg3 = getsound(xlgasound()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type arg6 = getsound(xlgasound()); + sound_type arg7 = getsound(xlgasound()); + double arg8 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_flute_all(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); + return cvsound(result); +} + + +#include "fmfb.h" + +/* xlc_snd_fmfb -- interface to C routine snd_fmfb */ +/**/ +LVAL xlc_snd_fmfb(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + double arg4 = testarg2(xlgaanynum()); + double arg5 = testarg2(xlgaanynum()); + sound_type result; + + xllastarg(); + result = snd_fmfb(arg1, arg2, arg3, arg4, arg5); + return cvsound(result); +} + + +#include "fmfbv.h" + +/* xlc_snd_fmfbv -- interface to C routine snd_fmfbv */ +/**/ +LVAL xlc_snd_fmfbv(void) +{ + double arg1 = testarg2(xlgaanynum()); + double arg2 = testarg2(xlgaanynum()); + double arg3 = testarg2(xlgaanynum()); + sound_type arg4 = getsound(xlgasound()); + sound_type result; + + xllastarg(); + result = snd_fmfbv(arg1, arg2, arg3, arg4); + return cvsound(result); +} + + diff --git a/nyqsrc/sndfnint.lsp b/nyqsrc/sndfnint.lsp new file mode 100644 index 0000000..83c897c --- /dev/null +++ b/nyqsrc/sndfnint.lsp @@ -0,0 +1,86 @@ + (setf snd-head-none 0) + + (setf snd-head-AIFF 1) + + (setf snd-head-IRCAM 2) + + (setf snd-head-NeXT 3) + + (setf snd-head-Wave 4) + + (setf snd-head-PAF 5) + + (setf snd-head-SVX 6) + + (setf snd-head-NIST 7) + + (setf snd-head-VOC 8) + + (setf snd-head-W64 9) + + (setf snd-head-MAT4 10) + + (setf snd-head-MAT5 11) + + (setf snd-head-PVF 12) + + (setf snd-head-XI 13) + + (setf snd-head-HTK 14) + + (setf snd-head-SDS 15) + + (setf snd-head-AVR 16) + + (setf snd-head-SD2 17) + + (setf snd-head-FLAC 18) + + (setf snd-head-CAF 19) + + (setf snd-head-raw 20) + + (setf snd-head-channels 1) + + (setf snd-head-mode 2) + + (setf snd-head-bits 4) + + (setf snd-head-srate 8) + + (setf snd-head-dur 16) + + (setf snd-head-latency 32) + + (setf snd-head-type 64) + + (setf snd-mode-adpcm 0) + + (setf snd-mode-pcm 1) + + (setf snd-mode-ulaw 2) + + (setf snd-mode-alaw 3) + + (setf snd-mode-float 4) + + (setf snd-mode-upcm 5) + + (setf snd-mode-unknown 6) + + (setf snd-mode-double 7) + + (setf snd-mode-GSM610 8) + + (setf snd-mode-DWVW 9) + + (setf snd-mode-DPCM 10) + + (setf snd-mode-msadpcm 11) + + (SETF MAX-STOP-TIME 10E20) + + (SETF MIN-START-TIME -10E20) + + (setf OP-AVERAGE 1) (setf OP-PEAK 2) + diff --git a/nyqsrc/sndfnintdefs.h b/nyqsrc/sndfnintdefs.h new file mode 100644 index 0000000..694f47f --- /dev/null +++ b/nyqsrc/sndfnintdefs.h @@ -0,0 +1,127 @@ +extern LVAL xlc_snd_set_latency(void); +extern LVAL xlc_soundp(void); +extern LVAL xlc_hz_to_step(void); +extern LVAL xlc_snd_set_logical_stop(void); +extern LVAL xlc_log(void); +extern LVAL xlc_snd_sref(void); +extern LVAL xlc_sref_inverse(void); +extern LVAL xlc_snd_stop_time(void); +extern LVAL xlc_snd_time(void); +extern LVAL xlc_snd_srate(void); +extern LVAL xlc_snd_t0(void); +extern LVAL xlc_snd_xform(void); +extern LVAL xlc_block_watch(void); +extern LVAL xlc_sound_nth_block(void); +extern LVAL xlc_snd_copy(void); +extern LVAL xlc_snd_print(void); +extern LVAL xlc_snd_play(void); +extern LVAL xlc_stats(void); +extern LVAL xlc_snd_print_tree(void); +extern LVAL xlc_snd_scale(void); +extern LVAL xlc_snd_zero(void); +extern LVAL xlc_step_to_hz(void); +extern LVAL xlc_snd_add(void); +extern LVAL xlc_snd_avg(void); +extern LVAL xlc_snd_compose(void); +extern LVAL xlc_snd_convolve(void); +extern LVAL xlc_snd_down(void); +extern LVAL xlc_snd_fft(void); +extern LVAL xlc_snd_inverse(void); +extern LVAL xlc_snd_multiseq(void); +extern LVAL xlc_snd_resample(void); +extern LVAL xlc_snd_resamplev(void); +extern LVAL xlc_snd_from_array(void); +extern LVAL xlc_snd_samples(void); +extern LVAL xlc_snd_length(void); +extern LVAL xlc_snd_maxsamp(void); +extern LVAL xlc_snd_fetch(void); +extern LVAL xlc_snd_fetch_array(void); +extern LVAL xlc_snd_max(void); +extern LVAL xlc_snd_read(void); +extern LVAL xlc_snd_seq(void); +extern LVAL xlc_snd_slider(void); +extern LVAL xlc_snd_save(void); +extern LVAL xlc_snd_overwrite(void); +extern LVAL xlc_snd_yin(void); +extern LVAL xlc_snd_trigger(void); +extern LVAL xlc_snd_lpanal(void); +extern LVAL xlc_snd_phasevocoder(void); +extern LVAL xlc_snd_abs(void); +extern LVAL xlc_snd_allpoles(void); +extern LVAL xlc_snd_alpass(void); +extern LVAL xlc_snd_alpasscv(void); +extern LVAL xlc_snd_alpassvv(void); +extern LVAL xlc_snd_amosc(void); +extern LVAL xlc_snd_areson(void); +extern LVAL xlc_snd_aresonvc(void); +extern LVAL xlc_snd_aresoncv(void); +extern LVAL xlc_snd_aresonvv(void); +extern LVAL xlc_snd_atone(void); +extern LVAL xlc_snd_atonev(void); +extern LVAL xlc_snd_biquad(void); +extern LVAL xlc_snd_buzz(void); +extern LVAL xlc_snd_chase(void); +extern LVAL xlc_snd_clip(void); +extern LVAL xlc_snd_congen(void); +extern LVAL xlc_snd_const(void); +extern LVAL xlc_snd_coterm(void); +extern LVAL xlc_snd_delay(void); +extern LVAL xlc_snd_delaycv(void); +extern LVAL xlc_snd_eqbandvvv(void); +extern LVAL xlc_snd_exp(void); +extern LVAL xlc_snd_follow(void); +extern LVAL xlc_snd_fmosc(void); +extern LVAL xlc_snd_fromobject(void); +extern LVAL xlc_snd_fromarraystream(void); +extern LVAL xlc_snd_gate(void); +extern LVAL xlc_snd_ifft(void); +extern LVAL xlc_snd_clarinet(void); +extern LVAL xlc_snd_clarinet_all(void); +extern LVAL xlc_snd_clarinet_freq(void); +extern LVAL xlc_snd_sax(void); +extern LVAL xlc_snd_sax_all(void); +extern LVAL xlc_snd_sax_freq(void); +extern LVAL xlc_snd_integrate(void); +extern LVAL xlc_snd_log(void); +extern LVAL xlc_snd_lpreson(void); +extern LVAL xlc_snd_maxv(void); +extern LVAL xlc_snd_offset(void); +extern LVAL xlc_snd_oneshot(void); +extern LVAL xlc_snd_osc(void); +extern LVAL xlc_snd_partial(void); +extern LVAL xlc_snd_pluck(void); +extern LVAL xlc_snd_prod(void); +extern LVAL xlc_snd_pwl(void); +extern LVAL xlc_snd_quantize(void); +extern LVAL xlc_snd_recip(void); +extern LVAL xlc_snd_reson(void); +extern LVAL xlc_snd_resonvc(void); +extern LVAL xlc_snd_resoncv(void); +extern LVAL xlc_snd_resonvv(void); +extern LVAL xlc_snd_sampler(void); +extern LVAL xlc_snd_normalize(void); +extern LVAL xlc_snd_shape(void); +extern LVAL xlc_snd_sine(void); +extern LVAL xlc_snd_siosc(void); +extern LVAL xlc_snd_slope(void); +extern LVAL xlc_snd_sqrt(void); +extern LVAL xlc_snd_tapf(void); +extern LVAL xlc_snd_tapv(void); +extern LVAL xlc_snd_tone(void); +extern LVAL xlc_snd_tonev(void); +extern LVAL xlc_snd_up(void); +extern LVAL xlc_snd_white(void); +extern LVAL xlc_snd_stkrev(void); +extern LVAL xlc_snd_stkpitshift(void); +extern LVAL xlc_snd_stkchorus(void); +extern LVAL xlc_snd_bowed(void); +extern LVAL xlc_snd_bowed_freq(void); +extern LVAL xlc_snd_bandedwg(void); +extern LVAL xlc_snd_mandolin(void); +extern LVAL xlc_snd_sitar(void); +extern LVAL xlc_snd_modalbar(void); +extern LVAL xlc_snd_flute(void); +extern LVAL xlc_snd_flute_freq(void); +extern LVAL xlc_snd_flute_all(void); +extern LVAL xlc_snd_fmfb(void); +extern LVAL xlc_snd_fmfbv(void); diff --git a/nyqsrc/sndfnintptrs.h b/nyqsrc/sndfnintptrs.h new file mode 100644 index 0000000..67f48b5 --- /dev/null +++ b/nyqsrc/sndfnintptrs.h @@ -0,0 +1,127 @@ + { "SND-SET-LATENCY", S, xlc_snd_set_latency}, + { "SOUNDP", S, xlc_soundp}, + { "HZ-TO-STEP", S, xlc_hz_to_step}, + { "SND-SET-LOGICAL-STOP", S, xlc_snd_set_logical_stop}, + { "LOG", S, xlc_log}, + { "SND-SREF", S, xlc_snd_sref}, + { "SREF-INVERSE", S, xlc_sref_inverse}, + { "SND-STOP-TIME", S, xlc_snd_stop_time}, + { "SND-TIME", S, xlc_snd_time}, + { "SND-SRATE", S, xlc_snd_srate}, + { "SND-T0", S, xlc_snd_t0}, + { "SND-XFORM", S, xlc_snd_xform}, + { "BLOCK-WATCH", S, xlc_block_watch}, + { "SOUND-NTH-BLOCK", S, xlc_sound_nth_block}, + { "SND-COPY", S, xlc_snd_copy}, + { "SND-PRINT", S, xlc_snd_print}, + { "SND-PLAY", S, xlc_snd_play}, + { "STATS", S, xlc_stats}, + { "SND-PRINT-TREE", S, xlc_snd_print_tree}, + { "SND-SCALE", S, xlc_snd_scale}, + { "SND-ZERO", S, xlc_snd_zero}, + { "STEP-TO-HZ", S, xlc_step_to_hz}, + { "SND-ADD", S, xlc_snd_add}, + { "SND-AVG", S, xlc_snd_avg}, + { "SND-COMPOSE", S, xlc_snd_compose}, + { "SND-CONVOLVE", S, xlc_snd_convolve}, + { "SND-DOWN", S, xlc_snd_down}, + { "SND-FFT", S, xlc_snd_fft}, + { "SND-INVERSE", S, xlc_snd_inverse}, + { "SND-MULTISEQ", S, xlc_snd_multiseq}, + { "SND-RESAMPLE", S, xlc_snd_resample}, + { "SND-RESAMPLEV", S, xlc_snd_resamplev}, + { "SND-FROM-ARRAY", S, xlc_snd_from_array}, + { "SND-SAMPLES", S, xlc_snd_samples}, + { "SND-LENGTH", S, xlc_snd_length}, + { "SND-MAXSAMP", S, xlc_snd_maxsamp}, + { "SND-FETCH", S, xlc_snd_fetch}, + { "SND-FETCH-ARRAY", S, xlc_snd_fetch_array}, + { "SND-MAX", S, xlc_snd_max}, + { "SND-READ", S, xlc_snd_read}, + { "SND-SEQ", S, xlc_snd_seq}, + { "SND-SLIDER", S, xlc_snd_slider}, + { "SND-SAVE", S, xlc_snd_save}, + { "SND-OVERWRITE", S, xlc_snd_overwrite}, + { "SND-YIN", S, xlc_snd_yin}, + { "SND-TRIGGER", S, xlc_snd_trigger}, + { "SND-LPANAL", S, xlc_snd_lpanal}, + { "SND-PHASEVOCODER", S, xlc_snd_phasevocoder}, + { "SND-ABS", S, xlc_snd_abs}, + { "SND-ALLPOLES", S, xlc_snd_allpoles}, + { "SND-ALPASS", S, xlc_snd_alpass}, + { "SND-ALPASSCV", S, xlc_snd_alpasscv}, + { "SND-ALPASSVV", S, xlc_snd_alpassvv}, + { "SND-AMOSC", S, xlc_snd_amosc}, + { "SND-ARESON", S, xlc_snd_areson}, + { "SND-ARESONVC", S, xlc_snd_aresonvc}, + { "SND-ARESONCV", S, xlc_snd_aresoncv}, + { "SND-ARESONVV", S, xlc_snd_aresonvv}, + { "SND-ATONE", S, xlc_snd_atone}, + { "SND-ATONEV", S, xlc_snd_atonev}, + { "SND-BIQUAD", S, xlc_snd_biquad}, + { "SND-BUZZ", S, xlc_snd_buzz}, + { "SND-CHASE", S, xlc_snd_chase}, + { "SND-CLIP", S, xlc_snd_clip}, + { "SND-CONGEN", S, xlc_snd_congen}, + { "SND-CONST", S, xlc_snd_const}, + { "SND-COTERM", S, xlc_snd_coterm}, + { "SND-DELAY", S, xlc_snd_delay}, + { "SND-DELAYCV", S, xlc_snd_delaycv}, + { "SND-EQBANDVVV", S, xlc_snd_eqbandvvv}, + { "SND-EXP", S, xlc_snd_exp}, + { "SND-FOLLOW", S, xlc_snd_follow}, + { "SND-FMOSC", S, xlc_snd_fmosc}, + { "SND-FROMOBJECT", S, xlc_snd_fromobject}, + { "SND-FROMARRAYSTREAM", S, xlc_snd_fromarraystream}, + { "SND-GATE", S, xlc_snd_gate}, + { "SND-IFFT", S, xlc_snd_ifft}, + { "SND-CLARINET", S, xlc_snd_clarinet}, + { "SND-CLARINET_ALL", S, xlc_snd_clarinet_all}, + { "SND-CLARINET_FREQ", S, xlc_snd_clarinet_freq}, + { "SND-SAX", S, xlc_snd_sax}, + { "SND-SAX_ALL", S, xlc_snd_sax_all}, + { "SND-SAX_FREQ", S, xlc_snd_sax_freq}, + { "SND-INTEGRATE", S, xlc_snd_integrate}, + { "SND-LOG", S, xlc_snd_log}, + { "SND-LPRESON", S, xlc_snd_lpreson}, + { "SND-MAXV", S, xlc_snd_maxv}, + { "SND-OFFSET", S, xlc_snd_offset}, + { "SND-ONESHOT", S, xlc_snd_oneshot}, + { "SND-OSC", S, xlc_snd_osc}, + { "SND-PARTIAL", S, xlc_snd_partial}, + { "SND-PLUCK", S, xlc_snd_pluck}, + { "SND-PROD", S, xlc_snd_prod}, + { "SND-PWL", S, xlc_snd_pwl}, + { "SND-QUANTIZE", S, xlc_snd_quantize}, + { "SND-RECIP", S, xlc_snd_recip}, + { "SND-RESON", S, xlc_snd_reson}, + { "SND-RESONVC", S, xlc_snd_resonvc}, + { "SND-RESONCV", S, xlc_snd_resoncv}, + { "SND-RESONVV", S, xlc_snd_resonvv}, + { "SND-SAMPLER", S, xlc_snd_sampler}, + { "SND-NORMALIZE", S, xlc_snd_normalize}, + { "SND-SHAPE", S, xlc_snd_shape}, + { "SND-SINE", S, xlc_snd_sine}, + { "SND-SIOSC", S, xlc_snd_siosc}, + { "SND-SLOPE", S, xlc_snd_slope}, + { "SND-SQRT", S, xlc_snd_sqrt}, + { "SND-TAPF", S, xlc_snd_tapf}, + { "SND-TAPV", S, xlc_snd_tapv}, + { "SND-TONE", S, xlc_snd_tone}, + { "SND-TONEV", S, xlc_snd_tonev}, + { "SND-UP", S, xlc_snd_up}, + { "SND-WHITE", S, xlc_snd_white}, + { "SND-STKREV", S, xlc_snd_stkrev}, + { "SND-STKPITSHIFT", S, xlc_snd_stkpitshift}, + { "SND-STKCHORUS", S, xlc_snd_stkchorus}, + { "SND-BOWED", S, xlc_snd_bowed}, + { "SND-BOWED_FREQ", S, xlc_snd_bowed_freq}, + { "SND-BANDEDWG", S, xlc_snd_bandedwg}, + { "SND-MANDOLIN", S, xlc_snd_mandolin}, + { "SND-SITAR", S, xlc_snd_sitar}, + { "SND-MODALBAR", S, xlc_snd_modalbar}, + { "SND-FLUTE", S, xlc_snd_flute}, + { "SND-FLUTE_FREQ", S, xlc_snd_flute_freq}, + { "SND-FLUTE_ALL", S, xlc_snd_flute_all}, + { "SND-FMFB", S, xlc_snd_fmfb}, + { "SND-FMFBV", S, xlc_snd_fmfbv}, diff --git a/nyqsrc/sndmax.c b/nyqsrc/sndmax.c new file mode 100644 index 0000000..a91297b --- /dev/null +++ b/nyqsrc/sndmax.c @@ -0,0 +1,73 @@ +/* sndmax.c -- computes the maximum amplitude in a sound */ + + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm min->MIN; fix compiler warning + * 31Jan07 rbd handle negative scale factors + */ + +#ifdef UNIX +#include "sys/types.h" +#endif +#include <stdio.h> +/* #include "snd.h" */ +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "sndmax.h" +#include "extern.h" + +double sound_max(LVAL snd_expr, long n) +{ + LVAL s_as_lval; + sound_type s = NULL; + long blocklen; + sample_block_values_type sbufp; + register double maximum = 0; + + s_as_lval = xleval(snd_expr); + /* BE CAREFUL - DO NOT ALLOW GC TO RUN WHILE LVAL IS UNPROTECTED */ + if (exttypep(s_as_lval, a_sound)) { + /* if snd_expr was simply a symbol, then s now points to + a shared sound_node. If we read samples from it, then + the sound bound to the symbol will be destroyed, so + copy it first. If snd_expr was a real expression that + computed a new value, then the next garbage collection + will reclaim the sound_node. We need to make the new + sound reachable by the garbage collector to that any + lisp data reachable from the sound do not get collected. + To make the sound reachable, we need to allocate a node, + and the GC might run, so we need to protect the OLD s + but then make it unreachable. + We will let the GC collect the sound in the end. + */ + xlprot1(s_as_lval); + s = sound_copy(getsound(s_as_lval)); + s_as_lval = cvsound(s); /* destroys only ref. to original */ + /* printf("sound_max: copy is %x, lval %x\n", s, s_as_lval); */ + while (n > 0) { + long togo, j; + sample_block_type sampblock = + sound_get_next(s, &blocklen); + if (sampblock == zero_block || blocklen == 0) { + break; + } + togo = MIN(blocklen, n); + sbufp = sampblock->samples; + for (j = 0; j < togo; j++) { + register double samp = *sbufp++; + if (samp > maximum) maximum = samp; + else if (-samp > maximum) maximum = -samp; + } + n -= togo; + } + xlpop(); + } else { + xlerror("sound_max: expression did not return a sound", + s_as_lval); + } + return fabs(maximum * s->scale); +} + + diff --git a/nyqsrc/sndmax.h b/nyqsrc/sndmax.h new file mode 100644 index 0000000..b18f294 --- /dev/null +++ b/nyqsrc/sndmax.h @@ -0,0 +1,4 @@ +/* sndmax.h -- header to write sounds to files */ + +double sound_max(LVAL snd_expr, long n); +/* LISP: (SND-MAX ANY FIXNUM) */ diff --git a/nyqsrc/sndread.c b/nyqsrc/sndread.c new file mode 100644 index 0000000..5087abb --- /dev/null +++ b/nyqsrc/sndread.c @@ -0,0 +1,297 @@ +/* sndread.c -- read sound files */ + +/* CHANGELOG + * + * 29Jun95 RBD ULAW fixed problems with signed chars + * 28Apr03 dm explicitly declare sndread_file_open_count as int + * 24Jul08 RBD & Judy Hawkins -- replace snd with PortAudio and libsndfile + */ + +#include "switches.h" +#include "stdio.h" +#include "string.h" +#ifdef UNIX +#include "sys/file.h" +#else +/* #include <unistd.h> */ +#ifdef WINDOWS +#include <sys/stat.h> +#include "io.h" +#else +#include <stat.h> +#endif +#define L_SET SEEK_SET +#define L_INCR SEEK_CUR +#define PROTECTION +#endif +#ifndef mips +#include "stdlib.h" +#endif +#include "sndfile.h" +#include "xlisp.h" +#include "sound.h" +#include "sndfmt.h" +#include "falloc.h" +#include "sndread.h" +#include "multiread.h" + +/* file.h doesn't define O_RDONLY under RS6K AIX */ +#ifndef O_RDONLY +#define O_RDONLY 0 +#endif + +static int sndread_file_open_count = 0; + +void read__fetch(susp, snd_list) + register read_susp_type susp; + snd_list_type snd_list; +{ + long n; /* jlh Changed type to long, trying to make move_samples_... work */ + sample_block_type out; + register sample_block_values_type out_ptr; + /* allow up to 4 bytes/sample: jlh -- does this need to be 8? */ + /* FIX -- why 8? for doubles? Maybe it should be sizeof(sample). I think + this buffer was here to allow you to input any format and convert to + float. The assumption was no sample would be longer than 4 bytes and + after conversion, samples would be 4 byte floats. + */ + long in_count; /* jlh Trying to make move_samples_... work */ + + falloc_sample_block(out, "read__fetch"); + out_ptr = out->samples; + snd_list->block = out; + + in_count = sf_readf_float(susp->sndfile, out_ptr, max_sample_block_len); + + n = in_count; + + /* don't read too many */ + if (n > (susp->cnt - susp->susp.current)) { + n = susp->cnt - susp->susp.current; + } + + snd_list->block_len = n; + susp->susp.current += n; + + if (n == 0) { + /* we didn't read anything, but can't return length zero, so + convert snd_list to pointer to zero block */ + snd_list_terminate(snd_list); + } else if (n < max_sample_block_len) { + /* this should close file and free susp */ + snd_list_unref(snd_list->u.next); + /* if something is in buffer, terminate by pointing to zero block */ + snd_list->u.next = zero_snd_list; + } +} /* read__fetch */ + + +void read_free(read_susp_type susp) +{ + sf_close(susp->sndfile); + sndread_file_open_count--; + ffree_generic(susp, sizeof(read_susp_node), "read_free"); +} + + +void read_print_tree(read_susp_type susp, int n) +{ +} + + +LVAL snd_make_read( + unsigned char *filename, /* file to read */ + time_type offset, /* offset to skip (in seconds) */ + time_type t0, /* start time of resulting sound */ + long *format, /* AIFF, IRCAM, NeXT, etc. */ + long *channels, /* number of channels */ + long *mode, /* sample format: PCM, ALAW, etc. */ + long *bits, /* BPS: bits per sample */ + long *swap, /* swap bytes */ + double *srate, /* srate: sample rate */ + double *dur, /* duration (in seconds) to read */ + long *flags, /* which parameters have been set */ + long *byte_offset) /* byte offset in file of first sample */ +{ + register read_susp_type susp; + /* srate specified as input parameter */ + sample_type scale_factor = 1.0F; + sf_count_t frames; + double actual_dur; + + falloc_generic(susp, read_susp_node, "snd_make_read"); + memset(&(susp->sf_info), 0, sizeof(SF_INFO)); + + susp->sf_info.samplerate = ROUND(*srate); + susp->sf_info.channels = *channels; + + switch (*mode) { + case SND_MODE_ADPCM: + susp->sf_info.format = SF_FORMAT_IMA_ADPCM; + break; + case SND_MODE_PCM: + if (*bits == 8) susp->sf_info.format = SF_FORMAT_PCM_S8; + else if (*bits == 16) susp->sf_info.format = SF_FORMAT_PCM_16; + else if (*bits == 24) susp->sf_info.format = SF_FORMAT_PCM_24; + else if (*bits == 32) susp->sf_info.format = SF_FORMAT_PCM_32; + else { + susp->sf_info.format = SF_FORMAT_PCM_16; + *bits = 16; + } + break; + case SND_MODE_ULAW: + susp->sf_info.format = SF_FORMAT_ULAW; + break; + case SND_MODE_ALAW: + susp->sf_info.format = SF_FORMAT_ALAW; + break; + case SND_MODE_FLOAT: + susp->sf_info.format = SF_FORMAT_FLOAT; + break; + case SND_MODE_UPCM: + susp->sf_info.format = SF_FORMAT_PCM_U8; + *bits = 8; + break; + } + + if (*format == SND_HEAD_RAW) susp->sf_info.format |= SF_FORMAT_RAW; + + if (*swap) { + /* set format to perform a byte swap (change from cpu endian-ness) */ + /* write the code so it will only compile if one and only one + ENDIAN setting is defined */ +#ifdef XL_LITTLE_ENDIAN + long format = SF_ENDIAN_BIG; +#endif +#ifdef XL_BIG_ENDIAN + long format = SF_ENDIAN_LITTLE; +#endif + susp->sf_info.format |= format; + } + + susp->sndfile = sf_open((const char *) filename, SFM_READ, + &(susp->sf_info)); + + if (!susp->sndfile) { + char error[240]; + sprintf(error, "SND-READ: Cannot open file '%s'", filename); + xlfail(error); + } + if (susp->sf_info.channels < 1) { + sf_close(susp->sndfile); + xlfail("Must specify 1 or more channels"); + } + + /* report samplerate from file, but if user provided a double + * as sample rate, don't replace it with an integer. + */ + if ((susp->sf_info.format & SF_FORMAT_TYPEMASK) != SF_FORMAT_RAW) { + *srate = susp->sf_info.samplerate; + } + /* compute dur */ + frames = sf_seek(susp->sndfile, 0, SEEK_END); + actual_dur = ((double) frames) / *srate; + if (offset < 0) offset = 0; + /* round offset to an integer frame count */ + frames = (sf_count_t) (offset * *srate + 0.5); + offset = ((double) frames) / *srate; + actual_dur -= offset; + if (actual_dur < 0) { + sf_close(susp->sndfile); + xlfail("SND-READ: offset is beyond end of file"); + } + if (actual_dur < *dur) *dur = actual_dur; + + sf_seek(susp->sndfile, frames, SEEK_SET); /* return to read loc in file */ + + /* initialize susp state */ + susp->susp.sr = *srate; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = read_print_tree; /*jlh empty function... */ + susp->susp.current = 0; + susp->susp.log_stop_cnt = UNKNOWN; + /* watch for overflow */ + if (*dur * *srate + 0.5 > (unsigned long) 0xFFFFFFFF) { + susp->cnt = 0x7FFFFFFF; + } else { + susp->cnt = ROUND((*dur) * *srate); + } + + switch (susp->sf_info.format & SF_FORMAT_TYPEMASK) { + case SF_FORMAT_WAV: *format = SND_HEAD_WAVE; break; + case SF_FORMAT_AIFF: *format = SND_HEAD_AIFF; break; + case SF_FORMAT_AU: *format = SND_HEAD_NEXT; break; + case SF_FORMAT_RAW: *format = SND_HEAD_RAW; break; + case SF_FORMAT_PAF: *format = SND_HEAD_PAF; break; + case SF_FORMAT_SVX: *format = SND_HEAD_SVX; break; + case SF_FORMAT_NIST: *format = SND_HEAD_NIST; break; + case SF_FORMAT_VOC: *format = SND_HEAD_VOC; break; + case SF_FORMAT_W64: *format = SND_HEAD_W64; break; + case SF_FORMAT_MAT4: *format = SND_HEAD_MAT4; break; + case SF_FORMAT_MAT5: *format = SND_HEAD_MAT5; break; + case SF_FORMAT_PVF: *format = SND_HEAD_PVF; break; + case SF_FORMAT_XI: *format = SND_HEAD_XI; break; + case SF_FORMAT_HTK: *mode = SND_HEAD_HTK; break; + case SF_FORMAT_SDS: *mode = SND_HEAD_SDS; break; + case SF_FORMAT_AVR: *mode = SND_HEAD_AVR; break; + case SF_FORMAT_WAVEX: *format = SND_HEAD_WAVE; break; + case SF_FORMAT_SD2: *format = SND_HEAD_SD2; break; + case SF_FORMAT_FLAC: *format = SND_HEAD_FLAC; break; + case SF_FORMAT_CAF: *format = SND_HEAD_CAF; break; + default: *format = SND_HEAD_NONE; break; + } + *channels = susp->sf_info.channels; + switch (susp->sf_info.format & SF_FORMAT_SUBMASK) { + case SF_FORMAT_PCM_S8: *bits = 8; *mode = SND_MODE_PCM; break; + case SF_FORMAT_PCM_16: *bits = 16; *mode = SND_MODE_PCM; break; + case SF_FORMAT_PCM_24: *bits = 24; *mode = SND_MODE_PCM; break; + case SF_FORMAT_PCM_32: *bits = 32; *mode = SND_MODE_PCM; break; + case SF_FORMAT_PCM_U8: *bits = 8; *mode = SND_MODE_UPCM; break; + case SF_FORMAT_FLOAT: *bits = 32; *mode = SND_MODE_FLOAT; break; + case SF_FORMAT_DOUBLE: *bits = 64; *mode = SND_MODE_DOUBLE; break; + case SF_FORMAT_ULAW: *bits = 8; *mode = SND_MODE_ULAW; break; + case SF_FORMAT_ALAW: *bits = 8; *mode = SND_MODE_ALAW; break; + case SF_FORMAT_IMA_ADPCM: *bits = 16; *mode = SND_MODE_ADPCM; break; + case SF_FORMAT_MS_ADPCM: *bits = 16; *mode = SND_MODE_ADPCM; break; + case SF_FORMAT_GSM610: *bits = 16; *mode = SND_MODE_GSM610; break; + case SF_FORMAT_VOX_ADPCM: *bits = 16; *mode = SND_MODE_ADPCM; break; + case SF_FORMAT_G721_32: *bits = 16; *mode = SND_MODE_ADPCM; break; + case SF_FORMAT_G723_24: *bits = 16; *mode = SND_MODE_ADPCM; break; + case SF_FORMAT_G723_40: *bits = 16; *mode = SND_MODE_ADPCM; break; + case SF_FORMAT_DWVW_12: *bits = 12; *mode = SND_MODE_DWVW; break; + case SF_FORMAT_DWVW_16: *bits = 16; *mode = SND_MODE_DWVW; break; + case SF_FORMAT_DWVW_24: *bits = 24; *mode = SND_MODE_DWVW; break; + case SF_FORMAT_DWVW_N: *bits = 32; *mode = SND_MODE_DWVW; break; + case SF_FORMAT_DPCM_8: *bits = 8; *mode = SND_MODE_DPCM; break; + case SF_FORMAT_DPCM_16: *bits = 16; *mode = SND_MODE_DPCM; break; + default: *mode = SND_MODE_UNKNOWN; break; + } + sndread_file_open_count++; +#ifdef MACINTOSH + if (sndread_file_open_count > 24) { + nyquist_printf("Warning: more than 24 sound files are now open\n"); + } +#endif + /* report info back to caller */ + if ((susp->sf_info.format & SF_FORMAT_TYPEMASK) != SF_FORMAT_RAW) { + *flags = SND_HEAD_CHANNELS | SND_HEAD_MODE | SND_HEAD_BITS | + SND_HEAD_SRATE | SND_HEAD_LEN | SND_HEAD_TYPE; + } + if (susp->sf_info.channels == 1) { + susp->susp.fetch = read__fetch; + susp->susp.free = read_free; + susp->susp.name = "read"; + return cvsound(sound_create((snd_susp_type)susp, t0, *srate, + scale_factor)); + } else { + susp->susp.fetch = multiread_fetch; + susp->susp.free = multiread_free; + susp->susp.name = "multiread"; + return multiread_create(susp); + } +} + + + + diff --git a/nyqsrc/sndread.h b/nyqsrc/sndread.h new file mode 100644 index 0000000..73dd7fd --- /dev/null +++ b/nyqsrc/sndread.h @@ -0,0 +1,20 @@ +/* fileio.h -- Nyquist code to read sound files */ + +/* for multiple channel files, one susp is shared by all sounds */ +/* the susp in turn must point back to all sound list tails */ + +typedef struct read_susp_struct { + snd_susp_node susp; + SNDFILE *sndfile; + SF_INFO sf_info; + snd_list_type *chan; /* array of back pointers */ + long cnt; /* how many sample frames to read */ +} read_susp_node, *read_susp_type; + + +LVAL snd_make_read(unsigned char *filename, time_type offset, time_type t0, + long *format, long *channels, long *mode, long *bits, long *swap, + double *srate, double *dur, long *flags, long *byte_offset); +/* LISP: (SND-READ STRING ANYNUM ANYNUM FIXNUM* FIXNUM* FIXNUM* FIXNUM* FIXNUM* ANYNUM* ANYNUM* FIXNUM^ FIXNUM^) */ + +void read_free(); diff --git a/nyqsrc/sndseq.c b/nyqsrc/sndseq.c new file mode 100644 index 0000000..edeb8b2 --- /dev/null +++ b/nyqsrc/sndseq.c @@ -0,0 +1,349 @@ +/* sndseq.c -- return a signal until its logical stop, then + evaluate a closure to get a signal and convert to an add + of two signals */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "scale.h" +#include "add.h" +#include "extern.h" +#include "cext.h" +#include "assert.h" + +#define SNDSEQDBG 0 +#define D if (SNDSEQDBG) + +/* Note: this structure is identical to an add_susp structure up + to the field output_per_s2 so that we can convert this into + an add after eval'ing the closure. Since this struct is bigger + than an add, make sure not to clobber the "free" routine + (sndseq_free) or else we'll leak memory. + */ +typedef struct sndseq_susp_struct { + snd_susp_node susp; + boolean started; + int terminate_bits; + long terminate_cnt; + int logical_stop_bits; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_type s1_bptr; /* block pointer */ + sample_block_values_type s1_ptr; + sound_type s2; + long s2_cnt; + sample_block_type s2_bptr; /* block pointer */ + sample_block_values_type s2_ptr; + + /* support for interpolation of s2 */ + sample_type s2_x1_sample; + double s2_phase; + double s2_phase_incr; + + /* support for ramp between samples of s2 */ + double output_per_s2; + + /* sndseq-specific data starts here */ + LVAL closure; + +} sndseq_susp_node, *sndseq_susp_type; + + +void sndseq_fetch(sndseq_susp_type, snd_list_type); +void sndseq_zero_fill_fetch(sndseq_susp_type, snd_list_type); +void sndseq_free(); + +extern LVAL s_stdout; + +void sndseq_mark(sndseq_susp_type susp) +{ +/* nyquist_printf("sndseq_mark(%x)\n", susp);*/ +/* nyquist_printf("marking s1@%x in sndseq@%x\n", susp->s1, susp); */ + sound_xlmark(susp->s1); + if (susp->closure) mark(susp->closure); +} + + + +/* sndseq_fetch returns blocks of s1 until the logical stop time of s1 */ +/**/ +void sndseq_fetch(susp, snd_list) + register sndseq_susp_type susp; + snd_list_type snd_list; +{ + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + +/* nyquist_printf("sndseq_fetch called: s1_cnt %d\n", susp->s1_cnt); */ + /* + * first compute how many samples to copy (or transfer) + */ + + /* get next samples; in add, the call is: + * susp_check_term_log_block_samples(s1, s1_bptr, s1_ptr, s1_cnt, 1, 3); + * + * the plan here is tricky: if s1 has logically stopped, then evaluate + * the closure to get signal s2. Then convert sndseq into an add. + */ + if (susp->s1_cnt == 0) { + susp_get_block_samples(s1, s1_bptr, s1_ptr, s1_cnt); + if (susp->s1_ptr == zero_block->samples) { + susp->terminate_bits = 1; /* mark s1 as terminated */ + } +/* nyquist_printf("sndseq_fetch: s1-lsc %d, current %d cnt %d\n", + susp->s1->logical_stop_cnt, susp->s1->current, susp->s1_cnt); */ + } + + if (susp->s1->logical_stop_cnt != UNKNOWN && + susp->s1->logical_stop_cnt == susp->s1->current - susp->s1_cnt) { + time_type now = susp->susp.t0 + susp->susp.current / susp->susp.sr; + /* note: cons args are protected from GC: */ + LVAL result; + long delay; /* sample delay to s2 */ +/* stats();gc();stats();*/ + + xlsave1(result); + +D nyquist_printf("sndseq_fetch: about to eval closure at %g, " + "susp->susp.t0 %g, susp.current %d:\n", + now, susp->susp.t0, (int)susp->susp.current); + result = xleval(cons(susp->closure, consa(cvflonum(now)))); + + susp->logical_stop_bits = 1; /* mark s1 as logically stopped */ + if (exttypep(result, a_sound)) { + susp->s2 = sound_copy(getsound(result)); +D nyquist_printf("sndseq: copied result from closure is %p\n", + susp->s2); + } else xlerror("closure did not return a (monophonic) sound", result); +D nyquist_printf("in sndseq: logically stopped; " + "%p returned from evform\n", + susp->s2); + susp->closure = NULL; /* allow garbage collection now */ + result = NIL; + + /**** Now convert to add ****/ + susp->susp.mark = add_mark; + susp->susp.log_stop_cnt = UNKNOWN; /* will be recomputed by add */ + susp->susp.print_tree = add_print_tree; + + /* assume sample rates are the same */ + if (susp->s1->sr != susp->s2->sr) + xlfail("in sndseq: sample rates must match"); + + /* take care of scale factor, if any */ + if (susp->s2->scale != 1.0) { + // stdputstr("normalizing next sound in a seq\n"); + susp->s2 = snd_make_normalize(susp->s2); + } + + /* figure out which add fetch routine to use */ + delay = ROUND((susp->s2->t0 - now) * susp->s1->sr); + if (susp->terminate_bits) { /* s1 is done, just get s2 now */ + sound_unref(susp->s1); + susp->s1 = NULL; + if (delay > 0) { /* need to fill zeros */ + susp->susp.fetch = add_zero_fill_nn_fetch; + susp->susp.name = "sndseq:add_zero_fill_nn_fetch"; + } else { + susp->susp.fetch = add_s2_nn_fetch; + susp->susp.name = "sndseq:add_s2_nn_fetch"; + } + } else if (delay > 0) { /* fill hole between s1 and s2 */ +D stdputstr("using add_s1_nn_fetch\n"); + susp->susp.fetch = add_s1_nn_fetch; + susp->susp.name = "sndseq:add_s1_nn_fetch"; + } else { + susp->susp.fetch = add_s1_s2_nn_fetch; + susp->susp.name = "sndseq:add_s1_s2_nn_fetch"; + } + + susp->s2_phase_incr = susp->s2->sr / susp->susp.sr; + susp->output_per_s2 = susp->susp.sr / susp->s2->sr; + +D stdputstr("in sndseq: calling add's fetch\n"); + (*(susp->susp.fetch))(susp, snd_list); +D stdputstr("in sndseq: returned from add's fetch\n"); +/* gc();*/ + xlpop(); + return; + } + + /* don't run past the s1 input sample block: */ + togo = susp->s1_cnt; +/* nyquist_printf("sndseq_fetch: togo initially %d then ", togo); */ + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + togo) { + togo = susp->terminate_cnt - susp->susp.current; + } + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - susp->susp.current; + togo = MIN(togo, to_stop); + } + assert(togo >= 0); + +/* nyquist_printf("%d\n", togo);*/ + /* + * two cases: copy a partial block or manipulate pointers for copyless + * transfer of whole block (may not be full block): + * + * copy partial block when: + * o samples begin in middle of block + * o stopping time is before end of block (when other signal splits + * the block for this signal). This happens if the logical + * stop time was externally dictated and falls mid-block. + * transfer (copyless) block when: + * o the block is of maximum size + * o the block is small due to logical stop time or termination time + */ + if (susp->s1_ptr == susp->s1_bptr->samples && susp->s1_cnt == togo) { + /* + * we want to copy this whole block (starting at the beginning + * and going to the rest of the block) -- just do pointers. + */ + + /* just fetch and pass blocks on */ +/* nyquist_printf("sndseq (s1_nn) %x starting uncopy, togo %d\n", susp, togo); */ + snd_list->block = susp->s1_bptr; + /* the zero_block indicates termination, don't copy it! Use + * internal_zero_block instead. It is also filled with zeros, + * but does not indicate termination. We must check for zero_block + * because the signal may have a logical stop time specified that + * extends beyond its termination time. + */ + if (snd_list->block == zero_block) + snd_list->block = internal_zero_block; + (snd_list->block->refcnt)++; +/* nyquist_printf("sndseq (s1_nn) %x shared block %x\n", susp, susp->s1_bptr);*/ + + susp_took(s1_cnt, togo); + snd_list->block_len = togo; + } else { + /* + * we want to copy a partial block + */ + + /* snd_list is the one with a null block */ + /* put a fresh, clean block in the snd_list (get new snd_list later) */ + falloc_sample_block(out, "sndseq_fetch"); + snd_list->block = out; + out_ptr = out->samples; + /* nyquist_printf("sndseq (s1_nn) %x new block %x\n", susp, out); */ + + n = togo; + /* nyquist_printf("sndseq (s1_nn) %x starting copy loop, togo %d\n", susp, togo); */ + while (n--) { /* the inner sample computation loop */ + /* scale? */ + *out_ptr++ = *(susp->s1_ptr++); + } /* inner loop */ + + susp_took(s1_cnt, togo); + snd_list->block_len = togo; + } + + /* add a new snd_list for the susp */ + susp->susp.current += togo; + +} /* sndseq_fetch */ + + +void sndseq_free(sndseq_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->s2); + ffree_generic(susp, sizeof(sndseq_susp_node), "sndseq_free"); +} + + +void sndseq_print_tree(sndseq_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("closure:"); + stdprint(susp->closure); + + indent(n); + stdputstr("s2:"); + sound_print_tree_1(susp->s2, n); +} + + + + +sound_type snd_make_sndseq(s1, closure) + sound_type s1; + LVAL closure; +{ + register sndseq_susp_type susp; + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + sound_type result; + + xlprot1(closure); + falloc_generic(susp, sndseq_susp_node, "snd_make_sndseq"); + + if (s1->scale != 1.0) { + /* stdputstr("normalizing first sound in a seq\n"); */ + s1 = snd_make_normalize(s1); + } + + susp->susp.fetch = sndseq_fetch; + + susp->terminate_cnt = UNKNOWN; + susp->terminate_bits = 0; /* bits for s1 and s2 termination */ + susp->logical_stop_bits = 0; /* bits for s1 and s2 logical stop */ + + /* initialize susp state */ + susp->susp.free = sndseq_free; + susp->susp.sr = s1->sr; + susp->susp.t0 = s1->t0; + susp->susp.mark = sndseq_mark; + susp->susp.print_tree = sndseq_print_tree; + susp->susp.name = "sndseq"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = s1->logical_stop_cnt; + if (!(susp->susp.log_stop_cnt >= 0 || susp->susp.log_stop_cnt == UNKNOWN)) { + xlerror("Behaviors in SEQ must appear in chronological order", closure); + } + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->s2 = NULL; + susp->s2_cnt = 0; + susp->s2_phase = 0.0; +/* susp->s2_phase_incr = ?? + susp->output_per_s2 = ?? */ + susp->closure = closure; + result = sound_create((snd_susp_type)susp, susp->susp.t0, susp->susp.sr, scale_factor); + xlpopn(1); + return result; +} + + +sound_type snd_sndseq(s1, closure) + sound_type s1; + LVAL closure; +{ + sound_type s1_copy; + s1_copy = sound_copy(s1); + return snd_make_sndseq(s1_copy, closure); +} diff --git a/nyqsrc/sndseq.h b/nyqsrc/sndseq.h new file mode 100644 index 0000000..03fdd11 --- /dev/null +++ b/nyqsrc/sndseq.h @@ -0,0 +1,3 @@ +sound_type snd_make_sndseq(); +sound_type snd_sndseq(); + /* LISP: (SND-SEQ SOUND ANY) */ diff --git a/nyqsrc/sndsliders.h b/nyqsrc/sndsliders.h new file mode 100644 index 0000000..ade86ba --- /dev/null +++ b/nyqsrc/sndsliders.h @@ -0,0 +1,5 @@ +/* sndsliders.h -- support for graphical sliders in Nyquist IDE */ + +sound_type snd_make_slider(int index, time_type t0, rate_type sr, time_type d); +sound_type snd_slider(int index, time_type t0, rate_type sr, time_type d); + /* LISP: (SND-SLIDER FIXNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/nyqsrc/sndwrite.c b/nyqsrc/sndwrite.c new file mode 100644 index 0000000..653ce37 --- /dev/null +++ b/nyqsrc/sndwrite.c @@ -0,0 +1,640 @@ +/* sndwrite.c -- write sounds to files */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability and fix compiler warnings + */ + +#include "stdlib.h" +#include "switches.h" +#include "string.h" +#ifdef UNIX +#include "sys/types.h" +#endif +#ifdef WINDOWS +#include <io.h> +#endif +#include <stdio.h> +/* include sound.h first because it includes math.h + * which declares abs(). cext.h #defines abs()! + * sound.h depends on xlisp.h + */ +#include "xlisp.h" +#include "sound.h" +#include "cext.h" +#include "userio.h" +#include "falloc.h" +#include "sndwrite.h" +#include "extern.h" +#include "snd.h" +#ifdef UNIX +#include "sys/file.h" +/* #include <sys/stat.h>*/ +/* #include <netinet/in.h> */ +#else +#ifdef MACINTOSH +#include <unistd.h> +#include <stat.h> +#define L_SET SEEK_SET +#define L_INCR SEEK_CUR +#endif +#endif + +#define D if (0) + +int sndwrite_trace = 0; /* debugging */ + +sample_type sound_save_sound(LVAL s_as_lval, long n, snd_type snd, + char *buf, long *ntotal, snd_type player); + +sample_type sound_save_array(LVAL sa, long n, snd_type snd, + char *buf, long *ntotal, snd_type player); + +unsigned char st_linear_to_ulaw(int sample); + + +typedef struct { + sound_type sound; + long cnt; + sample_block_values_type ptr; + double scale; + int terminated; +} sound_state_node, *sound_state_type; + + +LVAL prepare_audio(LVAL play, snd_type snd, snd_type player) +{ + long flags; + if (play == NIL) return NIL; + player->format = snd->format; + player->u.audio.devicename[0] = 0; + player->u.audio.interfacename[0] = 0; + if (snd_open(player, &flags) != SND_SUCCESS) { + xlabort("snd_save -- could not open audio output"); + } + /* make sure player and snd are compatible -- if not, set player to NULL + * and print a warning message + */ + if (player->format.channels == snd->format.channels && + player->format.mode == snd->format.mode && + player->format.bits == snd->format.bits) { + /* ok so far, check out the sample rate */ + if (player->format.srate != snd->format.srate) { + char msg[100]; + sprintf(msg, "%s(%g)%s(%g).\n", + "Warning: file sample rate ", snd->format.srate, + " differs from audio playback sample rate ", + player->format.srate); + stdputstr(msg); + } + } else { + stdputstr("File format not supported by audio output.\n"); + return NIL; + } + return play; +} + + +/* finish_audio -- flush the remaining samples, then close */ +/**/ +void finish_audio(snd_type player) +{ + /* note that this is a busy loop! */ + while (snd_flush(player) != SND_SUCCESS) ; + snd_close(player); +} + + +/* write_to_audio -- handle audio output from buffer */ +/* + * We want to write as soon as space is available so that + * a full sound buffer can be queued up for output. This + * may require transferring only part of buf, so we keep + * track of progress and output whenever space is available. + */ +void write_to_audio(snd_type player, void *buf, long buflen) +{ + long rslt; + while (buflen) { + /* this loop is a busy-wait loop! */ + rslt = snd_poll(player); /* wait for buffer space */ + rslt = min(rslt, buflen); + if (rslt) { + snd_write(player, buf, rslt); + buf = (void *) ((char *) buf + + (rslt * snd_bytes_per_frame(player))); + buflen -= rslt; + } + } +} + + +double sound_save( + LVAL snd_expr, + long n, + unsigned char *filename, + long format, + long mode, + long bits, + long swap, + double *sr, + long *nchans, + double *duration, + LVAL play) +{ + LVAL result; + char *buf; + long ntotal; + double max_sample; + snd_node snd; + snd_node player; + long flags; + + snd.device = SND_DEVICE_FILE; + snd.write_flag = SND_WRITE; + strcpy(snd.u.file.filename, (char *) filename); + snd.u.file.file = -1; /* this is a marker that snd is unopened */ + snd.u.file.header = format; + snd.format.mode = mode; + snd.format.bits = bits; + snd.u.file.swap = swap; + + player.device = SND_DEVICE_AUDIO; + player.write_flag = SND_WRITE; + player.u.audio.devicename[0] = '\0'; + player.u.audio.descriptor = NULL; + player.u.audio.protocol = SND_COMPUTEAHEAD; + player.u.audio.latency = 1.0; + player.u.audio.granularity = 0.0; + + if ((buf = (char *) malloc(max_sample_block_len * MAX_SND_CHANNELS * + sizeof(float))) == NULL) { + xlabort("snd_save -- couldn't allocate memory"); + } + + 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); + *nchans = snd.format.channels = i; + while (i > 0) { + i--; + if (!exttypep(getelement(result, i), a_sound)) { + xlerror("sound_save: array has non-sound element", + result); + } + } + /* assume all are the same: */ + *sr = snd.format.srate = getsound(getelement(result, 0))->sr; + + /* note: if filename is "", then don't write file; therefore, + * write the file if (filename[0]) + */ + if (filename[0] && snd_open(&snd, &flags) != SND_SUCCESS) { + xlabort("snd_save -- could not open sound file"); + } + + play = prepare_audio(play, &snd, &player); + + max_sample = sound_save_array(result, n, &snd, + buf, &ntotal, (play == NIL ? NULL : &player)); + *duration = ntotal / *sr; + if (filename[0]) snd_close(&snd); + if (play != NIL) finish_audio(&player); + } else if (exttypep(result, a_sound)) { + *nchans = snd.format.channels = 1; + *sr = snd.format.srate = (getsound(result))->sr; + if (filename[0] && snd_open(&snd, &flags) != SND_SUCCESS) { + xlabort("snd_save -- could not open sound file"); + } + + play = prepare_audio(play, &snd, &player); + + max_sample = sound_save_sound(result, n, &snd, + buf, &ntotal, (play == NIL ? NULL : &player)); + *duration = ntotal / *sr; + if (filename[0]) snd_close(&snd); + if (play != NIL) finish_audio(&player); + } else { + xlerror("sound_save: expression did not return a sound", + result); + max_sample = 0.0; + } + free(buf); + return max_sample; +} + + +double sound_overwrite( + LVAL snd_expr, + long n, + unsigned char *filename, + long byte_offset, + long header, + long mode, + long bits, + long swap, + double sr, + long nchans, + double *duration) +{ + LVAL result; + char *buf; + char error[140]; + long ntotal; + double max_sample; + snd_node snd; + long flags; + + snd.device = SND_DEVICE_FILE; + snd.write_flag = SND_OVERWRITE; + strcpy(snd.u.file.filename, (char *) filename); + snd.u.file.header = header; + snd.u.file.byte_offset = byte_offset; + snd.format.channels = nchans; + snd.format.mode = mode; + snd.format.bits = bits; + snd.u.file.swap = swap; + snd.format.srate = sr; + + if ((buf = (char *) malloc(max_sample_block_len * MAX_SND_CHANNELS * + sizeof(float))) == NULL) { + xlabort("snd_overwrite: couldn't allocate memory"); + } + + if (snd_open(&snd, &flags) != SND_SUCCESS) { + sprintf(error, + "snd_overwrite: cannot open file %s and seek to %d", + filename, (int)byte_offset); + free(buf); + xlabort(error); + } + + 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); + if (nchans != i) { + sprintf(error, "%s%d%s%d%s", + "snd_overwrite: number of channels in sound (", + (int)i, + ") does not match\n number of channels in file (", + (int)nchans, + ")"); + free(buf); + snd_close(&snd); + xlabort(error); + } + while (i > 0) { + i--; + if (!exttypep(getelement(result, i), a_sound)) { + free(buf); + snd_close(&snd); + xlerror("sound_save: array has non-sound element", + result); + } + } + /* assume all are the same: */ + if (sr != getsound(getelement(result, 0))->sr) { + sprintf(error, "%s%g%s%g%s", + "snd_overwrite: sample rate in sound (", + getsound(getelement(result, 0))->sr, + ") does not match\n sample rate in file (", + sr, + ")"); + free(buf); + snd_close(&snd); + xlabort(error); + } + + max_sample = sound_save_array(result, n, &snd, buf, &ntotal, NULL); + *duration = ntotal / sr; + } else if (exttypep(result, a_sound)) { + if (nchans != 1) { + sprintf(error, "%s%s%d%s", + "snd_overwrite: number of channels in sound (1", + ") does not match\n number of channels in file (", + (int)nchans, + ")"); + free(buf); + snd_close(&snd); + xlabort(error); + } + + if (sr != getsound(result)->sr) { + sprintf(error, "%s%g%s%g%s", + "snd_overwrite: sample rate in sound (", + getsound(result)->sr, + ") does not match\n sample rate in file (", + sr, + ")"); + free(buf); + snd_close(&snd); + xlabort(error); + } + + max_sample = sound_save_sound(result, n, &snd, buf, &ntotal, NULL); + *duration = ntotal / sr; + } else { + free(buf); + snd_close(&snd); + xlerror("sound_save: expression did not return a sound", + result); + max_sample = 0.0; + } + free(buf); + snd_close(&snd); + return max_sample; +} + + +cvtfn_type find_cvt_to_fn(snd_type snd, char *buf) +{ + cvtfn_type cvtfn; + /* find the conversion function */ + if (snd->format.bits == 8) cvtfn = cvt_to_8[snd->format.mode]; + else if (snd->format.bits == 16) cvtfn = cvt_to_16[snd->format.mode]; + else if (snd->format.bits == 24) cvtfn = cvt_to_24[snd->format.mode]; + else if (snd->format.bits == 32) cvtfn = cvt_to_32[snd->format.mode]; + else cvtfn = cvt_to_unknown; + + if (cvtfn == cvt_to_unknown) { + char error[50]; + sprintf(error, "Cannot write %d-bit samples in mode %s", + (int)snd->format.bits, snd_mode_to_string(snd->format.mode)); + free(buf); + snd_close(snd); + xlabort(error); + } + return cvtfn; +} + + +sample_type sound_save_sound(LVAL s_as_lval, long n, snd_type snd, + char *buf, long *ntotal, snd_type player) +{ + long blocklen; + long buflen; + sound_type s; + long debug_unit; /* print messages at intervals of this many samples */ + long debug_count; /* next point at which to print a message */ + sample_type max_sample = 0.0F; + cvtfn_type cvtfn; + *ntotal = 0; + + /* if snd_expr was simply a symbol, then s now points to + a shared sound_node. If we read samples from it, then + the sound bound to the symbol will be destroyed, so + copy it first. If snd_expr was a real expression that + computed a new value, then the next garbage collection + will reclaim the sound_node. We need to make the new + sound reachable by the garbage collector to that any + lisp data reachable from the sound do not get collected. + To make the sound reachable, we need to allocate a node, + and the GC might run, so we need to protect the OLD s + but then make it unreachable. + We will let the GC collect the sound in the end. + */ + xlprot1(s_as_lval); + s = sound_copy(getsound(s_as_lval)); + s_as_lval = cvsound(s); /* destroys only ref. to original */ + + /* for debugging */ +/* printing_this_sound = s;*/ + + + debug_unit = debug_count = (long) max(snd->format.srate, 10000.0); + + cvtfn = find_cvt_to_fn(snd, buf); + +#ifdef MACINTOSH + if (player) { + gprintf(TRANS, "Playing audio: Click and hold mouse button to stop playback.\n"); + } +#endif + + while (n > 0) { + long togo; + float peak; + sample_block_type sampblock = sound_get_next(s, &blocklen); + oscheck(); +#ifdef SNAPSHOTS + stdputstr("."); + if (sound_created_flag) { + stdputstr("SNAPSHOT: "); + sound_print_tree(printing_this_sound); + sound_created_flag = false; + } + fflush(stdout); +#endif + if (sampblock == zero_block || blocklen == 0) { + break; + } + togo = min(blocklen, n); + + buflen = (*cvtfn)((void *) buf, (void *) sampblock->samples, + togo, s->scale, &peak); + if (peak > max_sample) max_sample = peak; + +#ifdef MACINTOSH + if (Button()) { + if (player) { + snd_reset(player); + } + gprintf(TRANS, "\n\nStopping playback...\n\n\n"); + break; + } +#endif + + if (snd->u.file.file != -1) snd_write(snd, (void *) buf, buflen); + if (player) write_to_audio(player, (void *) buf, buflen); + + n -= togo; + *ntotal += togo; + if (*ntotal > debug_count) { + gprintf(TRANS, " %d ", *ntotal); + fflush(stdout); + debug_count += debug_unit; + } + } + gprintf(TRANS, "\ntotal samples: %d\n", *ntotal); + xlpop(); + return max_sample; +} + + +sample_type sound_save_array(LVAL sa, long n, snd_type snd, + char *buf, long *ntotal, snd_type player) +{ + long i, chans; + long buflen; + sound_state_type state; + double start_time = HUGE_VAL; + float *float_bufp; + LVAL sa_copy; + long debug_unit; /* print messages at intervals of this many samples */ + long debug_count; /* next point at which to print a message */ + sample_type max_sample = 0.0F; + cvtfn_type cvtfn; + + *ntotal = 0; + + /* THE ALGORITHM: first merge floating point samples from N channels + * into consecutive multi-channel frames in buf. Then, treat buf + * as just one channel and use one of the cvt_to_* functions to + * convert the data IN PLACE in the buffer (this is ok because the + * converted data will never take more space than the original 32-bit + * floats, so the converted data will not overwrite any floats before + * the floats are converted + */ + + /* if snd_expr was simply a symbol, then sa now points to + a shared sound_node. If we read samples from it, then + the sounds bound to the symbol will be destroyed, so + copy it first. If snd_expr was a real expression that + computed a new value, then the next garbage collection + will reclaim the sound array. See also sound_save_sound() + */ + chans = getsize(sa); + if (chans > MAX_SND_CHANNELS) { + xlerror("sound_save: too many channels", sa); + free(buf); + snd_close(snd); + } + xlprot1(sa); + sa_copy = newvector(chans); + xlprot1(sa_copy); + + /* Why do we copy the array into an xlisp array instead of just + * the state[i] array? Because some of these sounds may reference + * the lisp heap. We must put the sounds in an xlisp array so that + * the gc will find and mark them. xlprot1(sa_copy) makes the array + * visible to gc. + */ + for (i = 0; i < chans; i++) { + sound_type s = getsound(getelement(sa, i)); + setelement(sa_copy, i, cvsound(sound_copy(s))); + } + sa = sa_copy; /* destroy original reference to allow GC */ + + state = (sound_state_type) malloc(sizeof(sound_state_node) * chans); + for (i = 0; i < chans; i++) { + state[i].sound = getsound(getelement(sa, i)); + state[i].scale = state[i].sound->scale; +D nyquist_printf("save scale factor %d = %g\n", (int)i, state[i].scale); + state[i].terminated = false; + state[i].cnt = 0; /* force a fetch */ + start_time = min(start_time, state[i].sound->t0); + } + + for (i = 0; i < chans; i++) { + if (state[i].sound->t0 > start_time) + sound_prepend_zeros(state[i].sound, start_time); + } + + /* for debugging */ +/* printing_this_sound = s;*/ + + cvtfn = find_cvt_to_fn(snd, buf); + +#ifdef MACINTOSH + if (player) { + gprintf(TRANS, "Playing audio: Click and hold mouse button to stop playback.\n"); + } +#endif + + debug_unit = debug_count = (long) max(snd->format.srate, 10000.0); + + while (n > 0) { + /* keep the following information for each sound: + has it terminated? + pointer to samples + number of samples remaining in block + scan to find the minimum remaining samples and + output that many in an inner loop. Stop outer + loop if all sounds have terminated + */ + int terminated = true; + int togo = n; + int j; + float peak; + + oscheck(); + + for (i = 0; i < chans; i++) { + if (state[i].cnt == 0) { + if (sndwrite_trace) { + nyquist_printf("CALLING SOUND_GET_NEXT " + "ON CHANNEL %d (%p)\n", + (int)i, state[i].sound); + sound_print_tree(state[i].sound); + } + state[i].ptr = sound_get_next(state[i].sound, + &(state[i].cnt))->samples; + if (sndwrite_trace) { + nyquist_printf("RETURNED FROM CALL TO SOUND_GET_NEXT " + "ON CHANNEL %d\n", (int)i); + } + if (state[i].ptr == zero_block->samples) { + state[i].terminated = true; + } + } + if (!state[i].terminated) terminated = false; + togo = min(togo, state[i].cnt); + } + + if (terminated) break; + + float_bufp = (float *) buf; + for (j = 0; j < togo; j++) { + for (i = 0; i < chans; i++) { + double s = *(state[i].ptr++) * state[i].scale; + *float_bufp++ = (float) s; + } + } + // we're treating sound as mono for the conversion, so multiply + // togo by chans to get proper number of samples, and divide by + // chans to convert back to frame count required by snd_write + buflen = (*cvtfn)((void *) buf, (void *) buf, togo * chans, 1.0F, + &peak) / chans; + if (peak > max_sample) max_sample = peak; +#ifdef MACINTOSH + if (Button()) { + if (player) { + snd_reset(player); + } + gprintf(TRANS, "\n\nStopping playback...\n\n\n"); + break; + } +#endif + + if (snd->u.file.file != -1) snd_write(snd, (void *) buf, buflen); + if (player) write_to_audio(player, (void *) buf, buflen); + + n -= togo; + for (i = 0; i < chans; i++) { + state[i].cnt -= togo; + } + *ntotal += togo; + if (*ntotal > debug_count) { + gprintf(TRANS, " %d ", *ntotal); + fflush(stdout); + debug_count += debug_unit; + } + } + gprintf(TRANS, "total samples: %d x %d channels\n", + *ntotal, chans); + + /* references to sounds are shared by sa_copy and state[]. + * here, we dispose of state[], allowing GC to do the + * sound_unref call that frees the sounds. (Freeing them now + * would be a bug.) + */ + free(state); + xlpop(); + return max_sample; +} + + diff --git a/nyqsrc/sndwrite.h b/nyqsrc/sndwrite.h new file mode 100644 index 0000000..192317e --- /dev/null +++ b/nyqsrc/sndwrite.h @@ -0,0 +1,12 @@ +/* sndwrite.h -- header to write sounds to files */ + +double sound_save(LVAL snd_expr, long n, + unsigned char *filename, long format, + long mode, long bits, long swap, double *sr, long *nchans, + double *duration, LVAL play); +/* LISP: (SND-SAVE ANY FIXNUM STRING FIXNUM FIXNUM FIXNUM FIXNUM ANYNUM^ FIXNUM^ ANYNUM^ ANY) */ + +double sound_overwrite(LVAL snd_expr, long n, + unsigned char *filename, double offset_secs, long format, + long mode, long bits, long swap, double *duration); +/* LISP: (SND-OVERWRITE ANY FIXNUM STRING ANYNUM FIXNUM FIXNUM FIXNUM FIXNUM ANYNUM^) */ diff --git a/nyqsrc/sndwritepa.c b/nyqsrc/sndwritepa.c new file mode 100644 index 0000000..2f1989d --- /dev/null +++ b/nyqsrc/sndwritepa.c @@ -0,0 +1,818 @@ +/* sndwrite.c -- write sounds to files */ + +#include "stdlib.h" +#include "switches.h" +#include "string.h" +#ifdef UNIX +#include "sys/types.h" +#endif +#ifdef WINDOWS +#include <io.h> +#endif +#include <stdio.h> +/* include sound.h first because it includes math.h + * which declares abs(). cext.h #defines abs()! + * sound.h depends on xlisp.h + */ +#include "xlisp.h" +#include "sound.h" +#include "cext.h" +#include "userio.h" +#include "falloc.h" +#include "sndfmt.h" +#include "sndwrite.h" +#include "extern.h" +#include "sndfile.h" + +#ifdef UNIX +#include "sys/file.h" +/* #include <sys/stat.h>*/ +#include <netinet/in.h> +#else +#ifdef MACINTOSH +#include <unistd.h> +#include <stat.h> +#define L_SET SEEK_SET +#define L_INCR SEEK_CUR +#endif +#endif + +/* Previously, Nyquist would wrap samples that + * overflowed -- this produces horrible output, + * but makes it really easy to detect clipping, + * which I found helpful in my own work and good + * for students too since the effect is impossible + * to ignore. Now that Nyquist is doing IO to + * libraries that clip, we're going to artificially + * generate the wrapping here. This is floating point + * wrapping, so +1.0 does not wrap (it would if it + * were an integer since the maximum sample value for + * 16-bit data is a bit less than 1.) Since this is extra + * overhead, I'm trying to be a bit clever by using + * the compare to max_sample to eliminate compares + * for clipping in the common case. + * + * INPUTS: max_sample -- initially 0.0 + * threshold -- initially 0.0 + * s -- the value of the current sample + * x -- if s has to be wrapped, put the value here + */ +#define COMPUTE_MAXIMUM_AND_WRAP(x) \ + if (s > threshold) { \ + if (s > max_sample) { \ + max_sample = s; \ + threshold = min(1.0, s); \ + } \ + if (s > 1.0) { \ + s = fmod(s + 1.0, 2.0) - 1.0; \ + (x) = s; \ + } \ + } else if (s < -threshold) { \ + if (s < -max_sample) { \ + max_sample = -s; \ + threshold = min(1.0, -s); \ + } \ + if (s < -1.0) { \ + s = -(fmod(-s + 1.0, 2.0) - 1.0); \ + (x) = s; \ + } \ + } +// the s < -threshold case is tricky: +// flip the signal, do the wrap, flip again +// in order to pass positive values to fmod + + +/* When not using PCM encodings, we do not wrap + * samples -- therefore float sample formats do + * not wrap or clip when written to sound files + */ +#define COMPUTE_MAXIMUM() \ + if (s > max_sample) { \ + max_sample = s; \ + } else if (s < -max_sample) { \ + max_sample = -s; \ + } + +// should be looking for local portaudio +#include "portaudio.h" + +long flush_count = 0; /* how many samples to write to finish */ + +#define D if (0) + +int sndwrite_trace = 0; /* debugging */ + +static int portaudio_initialized = false; /* is PortAudio initialized? */ + +void portaudio_exit() +{ + if (portaudio_initialized) { + Pa_Terminate(); + } +} + + +sample_type sound_save_sound(LVAL s_as_lval, long n, SF_INFO *sf_info, SNDFILE *snd_file, + float *buf, long *ntotal, PaStream *audio_stream); + +sample_type sound_save_array(LVAL sa, long n, SF_INFO *sf_info, SNDFILE *snd_file, + float *buf, long *ntotal, PaStream *audio_stream); + +unsigned char st_linear_to_ulaw(int sample);/* jlh not used anywhere */ + + +typedef struct { + sound_type sound; + long cnt; + sample_block_values_type ptr; + double scale; + int terminated; +} sound_state_node, *sound_state_type; + + +static int portaudio_error(PaError err, char *problem) +{ + char msgbuffer[256]; + if (err != paNoError) { + sprintf(msgbuffer, "%s, error %d, %s.", problem, (int) err, + Pa_GetErrorText(err)); + xlerrprint("warning", NULL, msgbuffer, s_unbound); + return true; + } + return false; +} + + +LVAL prepare_audio(LVAL play, SF_INFO *sf_info, PaStream **audio_stream) +{ + PaStreamParameters output_parameters; + int i; + int num_devices; + const PaDeviceInfo *device_info; + const PaHostApiInfo *host_info; + + if (!portaudio_initialized) { + if (portaudio_error(Pa_Initialize(), + "could not initialize portaudio")) { + return NIL; + } + portaudio_initialized = TRUE; + } + + output_parameters.device = Pa_GetDefaultOutputDevice(); + output_parameters.channelCount = sf_info->channels; + output_parameters.sampleFormat = paFloat32; + output_parameters.hostApiSpecificStreamInfo = NULL; + /* remember that Nyquist has to do GC */ + output_parameters.suggestedLatency = sound_latency; + + // Initialize the audio stream for output + // If this is Linux, prefer to open ALSA device + num_devices = Pa_GetDeviceCount(); + for (i = 0; i < num_devices; i++) { + device_info = Pa_GetDeviceInfo(i); + host_info = Pa_GetHostApiInfo(device_info->hostApi); + if (host_info->type == paALSA) { + output_parameters.device = i; + break; + } + } + + if (portaudio_error( + Pa_OpenStream(audio_stream, NULL /* input */, &output_parameters, + sf_info->samplerate, max_sample_block_len, + paClipOff, NULL /* callback */, NULL /* userdata */), + "could not open audio")) { + return NIL; + } + flush_count = (long) (sf_info->samplerate * (sound_latency + 0.2)); + + if (portaudio_error(Pa_StartStream(*audio_stream), + "could not start audio")) { + return NIL; + } + + return play; +} + + +/* finish_audio -- flush the remaining samples, then close */ +/**/ +void finish_audio(PaStream *audio_stream) +{ + /* portaudio_error(Pa_StopStream(audio_stream), "could not stop stream"); */ + /* write Latency frames of audio to make sure all samples are played */ + float zero[MAX_SND_CHANNELS * 16]; + int i; + for (i = 0; i < MAX_SND_CHANNELS * 16; i++) zero[i] = 0.0F; + while (flush_count > 0) { + Pa_WriteStream(audio_stream, zero, 16); + flush_count -= 16; + } + portaudio_error(Pa_CloseStream(audio_stream), "could not close audio"); +} + +long lookup_format(long format, long mode, long bits, long swap) +{ + long sf_mode; + long sf_format; + + switch (format) { + case SND_HEAD_NONE: return 0; break; // get info from file + case SND_HEAD_AIFF: sf_format = SF_FORMAT_AIFF; break; + case SND_HEAD_IRCAM: sf_format = SF_FORMAT_IRCAM; break; + case SND_HEAD_NEXT: sf_format = SF_FORMAT_AU; break; + case SND_HEAD_WAVE: sf_format = SF_FORMAT_WAV; break; + case SND_HEAD_PAF: sf_format = SF_FORMAT_PAF; break; + case SND_HEAD_SVX: sf_format = SF_FORMAT_SVX; break; + case SND_HEAD_NIST: sf_format = SF_FORMAT_NIST; break; + case SND_HEAD_VOC: sf_format = SF_FORMAT_VOC; break; + case SND_HEAD_W64: sf_format = SF_FORMAT_W64; break; + case SND_HEAD_MAT4: sf_format = SF_FORMAT_MAT4; break; + case SND_HEAD_MAT5: sf_format = SF_FORMAT_MAT5; break; + case SND_HEAD_PVF: sf_format = SF_FORMAT_PVF; break; + case SND_HEAD_XI: sf_format = SF_FORMAT_XI; break; + case SND_HEAD_HTK: sf_format = SF_FORMAT_HTK; break; + case SND_HEAD_SDS: sf_format = SF_FORMAT_SDS; break; + case SND_HEAD_AVR: sf_format = SF_FORMAT_AVR; break; + case SND_HEAD_SD2: sf_format = SF_FORMAT_SD2; break; + case SND_HEAD_FLAC: sf_format = SF_FORMAT_FLAC; break; + case SND_HEAD_CAF: sf_format = SF_FORMAT_CAF; break; + case SND_HEAD_RAW: + sf_format = SF_FORMAT_RAW; +#ifdef XL_BIG_ENDIAN + sf_format |= (swap ? SF_ENDIAN_LITTLE : SF_ENDIAN_BIG); +#endif +#ifdef XL_LITTLE_ENDIAN + sf_format |= (swap ? SF_ENDIAN_LITTLE : SF_ENDIAN_LITTLE); +#endif + break; + default: + sf_format = SF_FORMAT_WAV; + nyquist_printf("s-save: unrecognized format, using SND_HEAD_WAVE\n"); + break; + } + + switch (mode) { + case SND_MODE_ADPCM: sf_mode = SF_FORMAT_IMA_ADPCM; break; + case SND_MODE_UPCM: + if (bits <= 8) { + sf_mode = SF_FORMAT_PCM_U8; break; + } else { + nyquist_printf("s-save: SND_MODE_UPCM is for 8-bit samples only, " + "using PCM instead\n"); + } /* no break here, fall through to SND_MODE_PCM... */ + default: + nyquist_printf("s-save: unrecognized mode (%ld), using PCM\n", + mode); + /* no break, fall through as SND_MODE_PCM */ + case SND_MODE_PCM: + if (bits <= 8) sf_mode = SF_FORMAT_PCM_S8; + else if (bits <= 16) sf_mode = SF_FORMAT_PCM_16; + else if (bits <= 24) sf_mode = SF_FORMAT_PCM_24; + else if (bits <= 32) sf_mode = SF_FORMAT_PCM_32; + else { + sf_mode = SF_FORMAT_PCM_16; + nyquist_printf( + "s-save: bad bits parameter (%ld), using 16-bit PCM\n", + bits); + } + break; + case SND_MODE_ULAW: sf_mode = SF_FORMAT_ULAW; break; + case SND_MODE_ALAW: sf_mode = SF_FORMAT_ALAW; break; + case SND_MODE_FLOAT: sf_mode = SF_FORMAT_FLOAT; break; + case SND_MODE_DOUBLE: sf_mode = SF_FORMAT_DOUBLE; break; + case SND_MODE_UNKNOWN: sf_mode = SF_FORMAT_PCM_16; break; + case SND_MODE_GSM610: sf_mode = SF_FORMAT_GSM610; break; + case SND_MODE_DWVW: + if (bits <= 12) sf_mode = SF_FORMAT_DWVW_12; + else if (bits <= 16) sf_mode = SF_FORMAT_DWVW_16; + else if (bits <= 24) sf_mode = SF_FORMAT_DWVW_24; + else sf_mode = SF_FORMAT_DWVW_N; + break; + case SND_MODE_DPCM: + if (bits <= 8) sf_mode = SF_FORMAT_DPCM_8; + else if (bits <= 16) sf_mode = SF_FORMAT_DPCM_16; + else { + sf_mode = SF_FORMAT_DPCM_16; + nyquist_printf( + "s-save: bad bits parameter (%ld), using 16-bit DPCM\n", + bits); + } + break; + case SND_MODE_MSADPCM: sf_mode = SF_FORMAT_MS_ADPCM; break; + } + return sf_format | sf_mode; +} + + +double sound_save( + LVAL snd_expr, + long n, + unsigned char *filename, + long format, + long mode, + long bits, + long swap, + double *sr, + long *nchans, + double *duration, + LVAL play) +{ + LVAL result; + float *buf; + long ntotal; + double max_sample; + SNDFILE *sndfile = NULL; + SF_INFO sf_info; + PaStream *audio_stream = NULL; + + gc(); + + memset(&sf_info, 0, sizeof(sf_info)); + sf_info.format = lookup_format(format, mode, bits, swap); + + 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); + *nchans = sf_info.channels = i; + while (i > 0) { + i--; + if (!exttypep(getelement(result, i), a_sound)) { + xlerror("sound_save: array has non-sound element", + result); + } + } + /* assume all are the same: */ + *sr = sf_info.samplerate = ROUND(getsound(getelement(result, 0))->sr); + + /* note: if filename is "", then don't write file; therefore, + * write the file if (filename[0]) + */ + if (filename[0]) { + sndfile = sf_open((char *) filename, SFM_WRITE, &sf_info); + if (sndfile) { + /* use proper scale factor: 8000 vs 7FFF */ + sf_command(sndfile, SFC_SET_CLIPPING, NULL, SF_TRUE); + } + } + + if (play) + play = prepare_audio(play, &sf_info, &audio_stream); + + if ((buf = (float *) malloc(max_sample_block_len * sf_info.channels * + sizeof(float))) == NULL) { + xlabort("snd_save -- couldn't allocate memory"); + } + + max_sample = sound_save_array(result, n, &sf_info, sndfile, + buf, &ntotal, audio_stream); + *duration = ntotal / *sr; + if (sndfile) sf_close(sndfile); + if (play != NIL) finish_audio(audio_stream); + } else if (exttypep(result, a_sound)) { + *nchans = sf_info.channels = 1; + sf_info.samplerate = ROUND((getsound(result))->sr); + *sr = sf_info.samplerate; + if (filename[0]) { + sndfile = sf_open((char *) filename, SFM_WRITE, &sf_info); + if (sndfile) { + /* use proper scale factor: 8000 vs 7FFF */ + sf_command(sndfile, SFC_SET_CLIPPING, NULL, SF_TRUE); + } else xlabort("snd_save -- could not open file or bad parameters"); + } + if (play) + play = prepare_audio(play, &sf_info, &audio_stream); + + if ((buf = (float *) malloc(max_sample_block_len * + sizeof(float))) == NULL) { + xlabort("snd_save -- couldn't allocate memory"); + } + + max_sample = sound_save_sound(result, n, &sf_info, sndfile, + buf, &ntotal, audio_stream); + *duration = ntotal / *sr; + if (sndfile) sf_close(sndfile); + if (play != NIL) finish_audio(audio_stream); + } else { + xlerror("sound_save: expression did not return a sound", + result); + max_sample = 0.0; + } + free(buf); + return max_sample; +} + + +/* open_for_write -- helper function for sound_overwrite */ +/* + * if the format is RAW, then fill in sf_info according to + * sound sample rate and channels. Otherwise, open the file + * and see if the sample rate and channele match. + */ +SNDFILE *open_for_write(unsigned char *filename, long direction, + long format, SF_INFO *sf_info, int channels, + long srate, double offset, float **buf) +/* channels and srate are based on the sound we're writing to the file */ +{ + SNDFILE *sndfile; + sf_count_t frames; // frame count passed into sf_seek + char error[140]; // error messages are formatted here + sf_count_t rslt; // frame count returned from sf_seek + + if (format == SND_HEAD_RAW) { + sf_info->channels = channels; + sf_info->samplerate = srate; + } else { + sf_info->format = 0; + } + sndfile = sf_open((const char *) filename, direction, sf_info); + + if (!sndfile) { + sprintf(error, "snd_overwrite: cannot open file %s", filename); + xlabort(error); + } + /* use proper scale factor: 8000 vs 7FFF */ + sf_command(sndfile, SFC_SET_CLIPPING, NULL, SF_TRUE); + + frames = round(offset * sf_info->samplerate); + rslt = sf_seek(sndfile, frames, SEEK_SET); + if (rslt < 0) { + sprintf(error, "snd_overwrite: cannot seek to frame %lld of %s", + frames, filename); + xlabort(error); + } + if (sf_info->channels != channels) { + sprintf(error, "%s%d%s%d%s", + "snd_overwrite: number of channels in sound (", + channels, + ") does not match\n number of channels in file (", + sf_info->channels, ")"); + sf_close(sndfile); + xlabort(error); + } + + if (sf_info->samplerate != srate) { + sprintf(error, "%s%ld%s%d%s", + "snd_overwrite: sample rate in sound (", + srate, + ") does not match\n sample rate in file (", + sf_info->samplerate, + ")"); + sf_close(sndfile); + xlabort(error); + } + + if ((*buf = (float *) malloc(max_sample_block_len * channels * + sizeof(float))) == NULL) { + xlabort("snd_overwrite: couldn't allocate memory"); + } + return sndfile; +} + + +double sound_overwrite( + LVAL snd_expr, + long n, + unsigned char *filename, + double offset_secs, + long format, + long mode, + long bits, + long swap, + double *duration) +{ + LVAL result; // the SOUND to be evaluated + SF_INFO sf_info; // info about the sound file + double max_sample; // return value + long ntotal; // how many samples were overwritten + /* + long flags; + */ + // first check if sound file exists, do not create new file + FILE *file = fopen((char *) filename, "rb"); + // if not then fail + if (!file) { + *duration = 0; + return 0.0; + } else { + fclose(file); + } + memset(&sf_info, 0, sizeof(sf_info)); + sf_info.format = lookup_format(format, mode, bits, swap); + result = xleval(snd_expr); + /* BE CAREFUL - DO NOT ALLOW GC TO RUN WHILE RESULT IS UNPROTECTED */ + if (vectorp(result)) { + SNDFILE *sndfile; // opened sound file + float *buf; // buffer for samples read in from sound file + /* make sure all elements are of type a_sound */ + long i = getsize(result); + long channels = i; + while (i > 0) { + i--; + if (!exttypep(getelement(result, i), a_sound)) { + xlerror("sound_save: array has non-sound element", + result); + } + } + sndfile = open_for_write(filename, SFM_RDWR, format, &sf_info, channels, + ROUND(getsound(getelement(result, 0))->sr), + offset_secs, &buf); + + max_sample = sound_save_array(result, n, &sf_info, sndfile, + buf, &ntotal, NULL); + *duration = ntotal / (double) sf_info.samplerate; + free(buf); + sf_close(sndfile); + } else if (exttypep(result, a_sound)) { + SNDFILE *sndfile; // opened sound file + float *buf; // buffer for samples read in from sound file + sndfile = open_for_write(filename, SFM_RDWR, format, &sf_info, 1, + ROUND(getsound(result)->sr), + offset_secs, &buf); + max_sample = sound_save_sound(result, n, &sf_info, sndfile, buf, + &ntotal, NULL); + *duration = ntotal / (double) sf_info.samplerate; + free(buf); + sf_close(sndfile); + } else { + xlerror("sound_save: expression did not return a sound", + result); + max_sample = 0.0; + } + return max_sample; +} + +int is_pcm(SF_INFO *sf_info) +{ + long subtype = sf_info->format & SF_FORMAT_SUBMASK; + return (subtype == SF_FORMAT_PCM_S8 || subtype == SF_FORMAT_PCM_16 || + subtype == SF_FORMAT_PCM_24 || subtype == SF_FORMAT_PCM_32); +} + + +sample_type sound_save_sound(LVAL s_as_lval, long n, SF_INFO *sf_info, + SNDFILE *sndfile, float *buf, long *ntotal, PaStream *audio_stream) +{ + long blocklen; + sound_type s; + int i; + sample_type *samps; + long debug_unit; /* print messages at intervals of this many samples */ + long debug_count; /* next point at which to print a message */ + sample_type max_sample = 0.0F; + sample_type threshold = 0.0F; + /* jlh cvtfn_type cvtfn; */ + *ntotal = 0; + + /* if snd_expr was simply a symbol, then s now points to + a shared sound_node. If we read samples from it, then + the sound bound to the symbol will be destroyed, so + copy it first. If snd_expr was a real expression that + computed a new value, then the next garbage collection + will reclaim the sound_node. We need to make the new + sound reachable by the garbage collector to that any + lisp data reachable from the sound do not get collected. + To make the sound reachable, we need to allocate a node, + and the GC might run, so we need to protect the OLD s + but then make it unreachable. + We will let the GC collect the sound in the end. + */ + xlprot1(s_as_lval); + s = sound_copy(getsound(s_as_lval)); + s_as_lval = cvsound(s); /* destroys only ref. to original */ + + /* for debugging */ +/* printing_this_sound = s;*/ + + + debug_unit = debug_count = (long) max(sf_info->samplerate, 10000.0); + + sound_frames = 0; + sound_srate = sf_info->samplerate; + + while (n > 0) { + long togo; + sample_block_type sampblock = sound_get_next(s, &blocklen); + oscheck(); +#ifdef SNAPSHOTS + stdputstr("."); + if (sound_created_flag) { + stdputstr("SNAPSHOT: "); + sound_print_tree(printing_this_sound); + sound_created_flag = false; + } + fflush(stdout); +#endif + if (sampblock == zero_block || blocklen == 0) { + break; + } + togo = min(blocklen, n); + if (s->scale != 1) { /* copy/scale samples into buf */ + for (i = 0; i < togo; i++) { + buf[i] = s->scale * sampblock->samples[i]; + } + samps = buf; + } else { + samps = sampblock->samples; + } + if (is_pcm(sf_info)) { + for (i = 0; i < togo; i++) { + sample_type s = samps[i]; + COMPUTE_MAXIMUM_AND_WRAP(samps[i]); + } + } else { + for (i = 0; i < togo; i++) { + sample_type s = samps[i]; + COMPUTE_MAXIMUM(); + } + } + if (sndfile) { + sf_writef_float(sndfile, samps, togo); + } + if (audio_stream) { + Pa_WriteStream(audio_stream, samps, togo); + sound_frames += togo; + } + + n -= togo; + *ntotal += togo; + if (*ntotal > debug_count) { + gprintf(TRANS, " %ld ", *ntotal); + fflush(stdout); + debug_count += debug_unit; + } + } + gprintf(TRANS, "\ntotal samples: %ld\n", *ntotal); + xlpop(); + return max_sample; +} + + +sample_type sound_save_array(LVAL sa, long n, SF_INFO *sf_info, + SNDFILE *sndfile, float *buf, long *ntotal, PaStream *audio_stream) +{ + long i, chans; + float *float_bufp; + sound_state_type state; + double start_time = HUGE_VAL; + LVAL sa_copy; + long debug_unit; /* print messages at intervals of this many samples */ + long debug_count; /* next point at which to print a message */ + sample_type max_sample = 0.0F; + sample_type threshold = 0.0F; + /* cvtfn_type cvtfn; jlh */ + + *ntotal = 0; + + /* THE ALGORITHM: first merge floating point samples from N channels + * into consecutive multi-channel frames in buf. Then, treat buf + * as just one channel and use one of the cvt_to_* functions to + * convert the data IN PLACE in the buffer (this is ok because the + * converted data will never take more space than the original 32-bit + * floats, so the converted data will not overwrite any floats before + * the floats are converted + */ + + /* if snd_expr was simply a symbol, then sa now points to + a shared sound_node. If we read samples from it, then + the sounds bound to the symbol will be destroyed, so + copy it first. If snd_expr was a real expression that + computed a new value, then the next garbage collection + will reclaim the sound array. See also sound_save_sound() + */ + + chans = getsize(sa); + if (chans > MAX_SND_CHANNELS) { + xlerror("sound_save: too many channels", sa); + free(buf); + sf_close(sndfile); + } + xlprot1(sa); + sa_copy = newvector(chans); + xlprot1(sa_copy); + + /* Why do we copy the array into an xlisp array instead of just + * the state[i] array? Because some of these sounds may reference + * the lisp heap. We must put the sounds in an xlisp array so that + * the gc will find and mark them. xlprot1(sa_copy) makes the array + * visible to gc. + */ + for (i = 0; i < chans; i++) { + sound_type s = getsound(getelement(sa, i)); + setelement(sa_copy, i, cvsound(sound_copy(s))); + } + sa = sa_copy; /* destroy original reference to allow GC */ + + state = (sound_state_type) malloc(sizeof(sound_state_node) * chans); + for (i = 0; i < chans; i++) { + state[i].sound = getsound(getelement(sa, i)); + state[i].scale = state[i].sound->scale; +D nyquist_printf("save scale factor %ld = %g\n", i, state[i].scale); + state[i].terminated = false; + state[i].cnt = 0; /* force a fetch */ + start_time = min(start_time, state[i].sound->t0); + } + + for (i = 0; i < chans; i++) { + if (state[i].sound->t0 > start_time) + sound_prepend_zeros(state[i].sound, start_time); + } + + debug_unit = debug_count = (long) max(sf_info->samplerate, 10000.0); + + sound_frames = 0; + sound_srate = sf_info->samplerate; + while (n > 0) { + /* keep the following information for each sound: + has it terminated? + pointer to samples + number of samples remaining in block + scan to find the minimum remaining samples and + output that many in an inner loop. Stop outer + loop if all sounds have terminated + */ + int terminated = true; + int togo = n; + int j; + + oscheck(); + + for (i = 0; i < chans; i++) { + if (state[i].cnt == 0) { + if (sndwrite_trace) { + nyquist_printf("CALLING SOUND_GET_NEXT ON CHANNEL %ld (%lx)\n", + i, (unsigned long) state[i].sound); /* jlh 64 bit issue */ + sound_print_tree(state[i].sound); + } + state[i].ptr = sound_get_next(state[i].sound, + &(state[i].cnt))->samples; + if (sndwrite_trace) { + nyquist_printf("RETURNED FROM CALL TO SOUND_GET_NEXT ON CHANNEL %ld\n", i); + } + if (state[i].ptr == zero_block->samples) { + state[i].terminated = true; + } + } + if (!state[i].terminated) terminated = false; + togo = min(togo, state[i].cnt); + } + + if (terminated) break; + + float_bufp = (float *) buf; + if (is_pcm(sf_info)) { + for (j = 0; j < togo; j++) { + for (i = 0; i < chans; i++) { + float s = (float) (*(state[i].ptr++) * (float) state[i].scale); + COMPUTE_MAXIMUM_AND_WRAP(s); + *float_bufp++ = s; + } + } + } else { + for (j = 0; j < togo; j++) { + for (i = 0; i < chans; i++) { + float s = (float) (*(state[i].ptr++) * (float) state[i].scale); + COMPUTE_MAXIMUM(); + *float_bufp++ = s; + } + } + } + /* Here we have interleaved floats. Before converting to the sound + file format, call PortAudio to play them. */ + if (audio_stream) { + PaError err = Pa_WriteStream(audio_stream, buf, togo); + if (err) { + printf("Pa_WriteStream error %d\n", err); + } + sound_frames += togo; + } + if (sndfile) sf_writef_float(sndfile, buf, togo); + + n -= togo; + for (i = 0; i < chans; i++) { + state[i].cnt -= togo; + } + *ntotal += togo; + if (*ntotal > debug_count) { + gprintf(TRANS, " %ld ", *ntotal); + fflush(stdout); + debug_count += debug_unit; + } + } + gprintf(TRANS, "total samples: %ld x %ld channels\n", + *ntotal, chans); + + /* references to sounds are shared by sa_copy and state[]. + * here, we dispose of state[], allowing GC to do the + * sound_unref call that frees the sounds. (Freeing them now + * would be a bug.) + */ + free(state); + xlpop(); + return max_sample; +} + + diff --git a/nyqsrc/sound.c b/nyqsrc/sound.c new file mode 100644 index 0000000..9892d10 --- /dev/null +++ b/nyqsrc/sound.c @@ -0,0 +1,1709 @@ +/* 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; +} + + +/* 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) +{ + void (*freefunc)(); + + if (list == NULL || list == zero_snd_list) { + if (list == NULL) + nyquist_printf("why did snd_list_unref get %p?\n", list); + return; + } + list->refcnt--; +/* nyquist_printf("snd_list_unref "); print_snd_list_type(list); stdputstr("\n"); */ + if (list->refcnt == 0) { + if (list->block && list->block != zero_block) { + /* there is a next snd_list */ +/* stdputstr("["); */ + sample_block_unref(list->block); +/* stdputstr("]"); */ + snd_list_unref(list->u.next); + } + else if (list->block == NULL) { /* the next thing is the susp */ + /* free suspension structure */ + /* nyquist_printf("freeing susp@%p\n", list->u.susp); */ + freefunc = list->u.susp->free; + (*freefunc)(list->u.susp); + } + /* nyquist_printf("freeing snd_list@%p\n", list); */ + //DBY + if (list == list_watch) printf("freeing watched snd_list %p\n", list); + //DBY + ffree_snd_list(list, "snd_list_unref"); + } +} + + +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(steps) + double steps; +{ + return exp(steps * p1 + p2); +} + + +/* + * 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(s) +sound_type s; +{ + 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)); +} + diff --git a/nyqsrc/sound.h b/nyqsrc/sound.h new file mode 100644 index 0000000..70ace3c --- /dev/null +++ b/nyqsrc/sound.h @@ -0,0 +1,533 @@ +/* sound.h -- new nyquist sound data type */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 dm changes for portability: moved some defns out of here + */ + +#include <math.h> +#include "stdefs.h" + +/* used for *AUDIO-MARKERS* */ +extern long sound_frames; +extern double sound_srate; + +#if OSC +extern int nosc_enabled; /* enable polling for OSC messages */ +#endif + +#if USE_PRINTF +#define nyquist_printf printf +#endif + +#define PERMS 0644 /* -rw-r--r-- */ + +/* default stop sample count (for clipping) */ +#define MAX_STOP 0x7FFFFFFF + +/* default stop time (for clipping) */ +#define MAX_STOP_TIME 10E20 +/* LISP-SRC: (SETF MAX-STOP-TIME 10E20) */ +#define MIN_START_TIME -10E20 +/* LISP-SRC: (SETF MIN-START-TIME -10E20) */ + +/* conversion from float to integer */ +#define SCALE_FACTOR_TO_BYTE 127 +#define SCALE_FACTOR_TO_SHORT 32767 +#define SCALE_FACTOR_TO_24BIT 0x7FFFFF +#define SCALE_FACTOR_TO_LONG 2147483647 + +/* Note that the values assigned here are not arbitrary, but represent + a dominance relationship among the interpolation types. +*/ +#define INTERP_n 0 +#define INTERP_s 1 +#define INTERP_i 2 +#define INTERP_r 3 + +#define INTERP_nn 0 +#define INTERP_ns 1 +#define INTERP_ni 2 +#define INTERP_nr 3 +#define INTERP_sn 4 +#define INTERP_ss 5 +#define INTERP_si 6 +#define INTERP_sr 7 + +#define INTERP_nnn 0 +#define INTERP_nns 1 +#define INTERP_nni 2 +#define INTERP_nnr 3 +#define INTERP_nsn 4 +#define INTERP_nss 5 +#define INTERP_nsi 6 +#define INTERP_nsr 7 +#define INTERP_nin 8 +#define INTERP_nis 9 +#define INTERP_nii 10 +#define INTERP_nir 11 +#define INTERP_nrn 12 +#define INTERP_nrs 13 +#define INTERP_nri 14 +#define INTERP_nrr 15 +#define INTERP_snn 16 +#define INTERP_sns 17 +#define INTERP_sni 18 +#define INTERP_snr 19 +#define INTERP_ssn 20 +#define INTERP_sss 21 +#define INTERP_ssi 22 +#define INTERP_ssr 23 +#define INTERP_sin 24 +#define INTERP_sis 25 +#define INTERP_sii 26 +#define INTERP_sir 27 +#define INTERP_srn 28 +#define INTERP_srs 29 +#define INTERP_sri 30 +#define INTERP_srr 31 + +#define INTERP_nnnn 0 +#define INTERP_nnns 1 +#define INTERP_nnsn 4 +#define INTERP_nnss 5 +#define INTERP_nsnn 16 +#define INTERP_nsns 17 +#define INTERP_nssn 20 +#define INTERP_nsss 21 +#define INTERP_snnn 64 +#define INTERP_snns 65 +#define INTERP_snsn 68 +#define INTERP_snss 69 +#define INTERP_ssnn 80 +#define INTERP_ssns 81 +#define INTERP_sssn 84 +#define INTERP_ssss 85 +#define INTERP_niii 42 +#define INTERP_siii 106 +#define INTERP_nrrr 63 +#define INTERP_srrr 127 + +#define INTERP_nnnnnn 0 +#define INTERP_ssssss 1365 + +#define INTERP_nnnnnnnn 0 +#define INTERP_ssssssss 21845 + + +#define INTERP_MASK 3 +#define INTERP_SHIFT 2 + +LVAL snd_badsr(void); + +typedef double time_type; +typedef double rate_type; +typedef float sample_type; +typedef double promoted_sample_type; + +/* use radians or degrees for phase? */ +#define ANGLEBASE 360.0 + +/* used by sndwrite.c for output buffers. This should be + * eliminated: + */ +#define MAX_SND_CHANNELS 24 + +#define max_table_len 100000 +/* Set to 4 for debugging block allocation stuff, 1012? for + production +*/ +/* leave a few words short of 1024 in case we allocate powers of 2 */ +#define max_sample_block_len 1020 +/* #define max_sample_block_len 4 */ + +/* Defines needed for xlisp */ +#define getsound(x) ((sound_type) getinst(x)) +#define xlgasound() (testarg(typearg(soundp))) + +typedef short SFDataType, *SFDataPtr; + +typedef sample_type sample_block_values[max_sample_block_len], + *sample_block_values_type; + +typedef struct { + long refcnt; /* reference count */ + sample_block_values samples; +} sample_block_node, *sample_block_type; + + +typedef struct snd_susp_struct { + void (*fetch)(struct snd_susp_struct *, struct snd_susp_struct *); + void (*keep_fetch)(struct snd_susp_struct *); + void (*free)(struct snd_susp_struct *); + void (*mark)(struct snd_susp_struct *); /* marks LVAL nodes for GC */ + void (*print_tree)(struct snd_susp_struct *, int); /* debugging */ + char * name; /* string name for debugging */ + long toss_cnt; /* return this many zeros, then compute */ + long current; /* current sample number */ + double sr; /* sample rate */ + time_type t0; /* starting time */ + long log_stop_cnt; /* logical stop count */ + /* other susp dependent stuff will be here... */ +} snd_susp_node, *snd_susp_type; + + +typedef struct snd_list_struct { + sample_block_type block; /* pointer to block of samples */ + union { + struct snd_list_struct *next; + snd_susp_type susp; + } u; + short refcnt; + short block_len; + boolean logically_stopped; +} snd_list_node, *snd_list_type; + +extern snd_list_type list_watch; //DBY + + +typedef struct table_struct { + long refcount; /* reference count */ + double length; /* number of samples in table + (double allows fractional length)*/ + sample_type samples[1]; /* arbitrary length array of sample */ +} table_node, *table_type; + + +/* some counts are biased by -max_sample_block_len, so UNKNOWN can't be -1 + * Any number less than -max_sample_block should do + */ +#define UNKNOWN (-10-max_sample_block_len) + +typedef struct sound_struct { + sample_block_type (*get_next)(struct sound_struct *snd, long *cnt); + time_type time; /* logical starting time */ + time_type t0; /* quantized time of first sample */ + long stop; /* stop (clipping) sample no. */ + time_type true_t0; /* exact time of first sample */ + rate_type sr; /* sample rate */ + long current; /* current sample number, + if negative, then the first + -current samples must be dropped + in order to find the first sample */ + long logical_stop_cnt; /* log stop sample no, -1=unknwn */ + snd_list_type list; /* sample block list, starting at curr. samp */ + sample_type scale; /* scale factor for the result */ + long prepend_cnt; /* how many zeros to prepend */ + /* function to use as get_next after prepended zeros are generated: */ + sample_block_type (*after_prepend) + (struct sound_struct * snd, long * cnt); + table_type table; /* pointer to table-ized version of this sound */ + long *extra; /* used for extra state information, first word of extra + state should be the length of the extra state + (see sound_unref()) + */ +} sound_node, *sound_type; + +/* convert number of samples to memory size: */ +#define table_size_in_bytes(n) \ + (sizeof(table_node) + sizeof(sample_type) * ((n) - 1)) + +extern sample_block_type zero_block; +extern sample_block_type internal_zero_block; + +extern snd_list_type zero_snd_list; + +extern sound_type printing_this_sound; /* debugging global */ + +extern double sound_latency; /* controls output latency */ +double snd_set_latency(double latency); +/* LISP: (SND-SET-LATENCY FLONUM) */ + +double compute_phase(double phase, double key, long n, double srate, + double new_srate, double freq, double *incr_ptr); + +boolean soundp(LVAL); +/* LISP: (SOUNDP ANY) */ + +void snd_list_ref(snd_list_type list); +void sound_unref(sound_type snd); +void snd_list_unref(snd_list_type list); + +LVAL cvsound(sound_type); +extern LVAL a_sound; + +sample_block_type SND_get_next(sound_type snd, long * cnt); +sample_block_type SND_get_first(sound_type snd, long * cnt); +sample_block_type SND_get_zeros(sound_type snd, long * cnt); +sample_block_type SND_flush(sound_type snd, long * cnt); + +double hz_to_step(double); /* LISP: (HZ-TO-STEP ANYNUM) */ +int interp_style(sound_type s, rate_type sr); +void set_logical_stop_time(sound_type sound, time_type when); /* LISP: (SND-SET-LOGICAL-STOP SOUND ANYNUM) */ + +#define xlog(x) log(x) +/* LISP: double (LOG FLONUM) */ +snd_list_type snd_list_create(snd_susp_type susp); +void snd_list_terminate(snd_list_type snd_list); +void snd_sort_2(sound_type * s1_ptr, sound_type * s2_ptr, rate_type sr); + +double snd_sref(sound_type s, time_type t); + /* LISP: (SND-SREF SOUND ANYNUM) */ + +double snd_sref_inverse(sound_type s, double val); + /* LISP: (SREF-INVERSE SOUND ANYNUM) */ + +double snd_stop_time(sound_type s); /* LISP: (SND-STOP-TIME SOUND) */ +#define snd_time(s) (s)->time + /* LISP: double (SND-TIME SOUND) */ + +#define snd_srate(s) (s)->sr + /* LISP: double (SND-SRATE SOUND) */ +#define snd_t0(s) (s)->t0 + /* LISP: double (SND-T0 SOUND) */ + +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); + /* LISP: (SND-XFORM SOUND ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ +sound_type sound_create(snd_susp_type susp, time_type t0, rate_type sr, + promoted_sample_type scale); + +void min_cnt(long *cnt_ptr, sound_type sound, snd_susp_type susp, long cnt); +void indent(int n); +void sound_prepend_zeros(sound_type snd, time_type t0); + + + +#ifndef GCBUG +#define blocks_to_watch_max 50 +extern long blocks_to_watch_len; +extern sample_block_type blocks_to_watch[blocks_to_watch_max]; + +void block_watch(long sample_block); + /* LISP: (BLOCK-WATCH FIXNUM) */ +long sound_nth_block(sound_type snd, long n); + /* LISP: (SOUND-NTH-BLOCK SOUND FIXNUM) */ +#endif + +sound_type sound_copy(sound_type snd); + /* LISP: (SND-COPY SOUND) */ +void sound_xlmark(sound_type s); +void sound_print(LVAL snd_expr, long n); + /* LISP: (SND-PRINT ANY FIXNUM) */ +void sound_play(LVAL snd_expr); + /* LISP: (SND-PLAY ANY) */ +void stats(void); + /* LISP: (STATS) */ +void sound_print_tree(sound_type snd); + /* LISP: (SND-PRINT-TREE SOUND) */ + +void mark_audio_time(void); + +void sound_print_tree_1(sound_type snd, int n); + +sound_type sound_scale(double factor, sound_type snd); + /* LISP: (SND-SCALE ANYNUM SOUND) */ +void sound_init(void); + +void sound_symbols(void); + +table_type sound_to_table(sound_type s); + +void table_unref(table_type table); + +sound_type sound_zero(time_type t0, rate_type sr); + /* LISP: (SND-ZERO ANYNUM ANYNUM) */ + +#define sound_get_next(s, n) ((*(s->get_next))(s, n)) + +#define susp_print_tree(s, n) (*((s)->print_tree))(s, n) + +double step_to_hz(double); + /* LISP: (STEP-TO-HZ ANYNUM) */ + +/* macros for access to samples within a suspension */ +/* NOTE: assume suspension structure is named "susp" */ + +/* susp_check_samples points sample_ptr to a new sample block if necessary */ +#define susp_check_samples(sound, sample_ptr, sample_cnt) \ + if (susp->sample_cnt == 0) \ + susp_get_samples(sound, sample_ptr, sample_cnt) + +/* susp_check_samples_break is similar to susp_check_samples - "_break" + * normally means that this code will break out of the inner loop, but in + * this case, there is no reason (neither log nor term) to break. + * x2_sample is taken from sound + */ +#define susp_check_samples_break(sound, sample_ptr, sample_cnt, x2_sample) \ + if (susp->sample_cnt == 0) { \ + susp_get_samples(sound, sample_ptr, sample_cnt); \ + x2_sample = susp_current_sample(sound, sample_ptr); } + + +/* susp_get_samples always gets next block (useful only in initialization code) */ +#define susp_get_samples(sound, sample_ptr, sample_cnt) \ + susp->sample_ptr = sound_get_next(susp->sound, &(susp->sample_cnt))->samples + +/* susp_get_block_samples always gets next block (useful only in initialization code) */ +#define susp_get_block_samples(sound, sample_block_ptr, sample_ptr, sample_cnt) \ + susp->sample_block_ptr = sound_get_next(susp->sound, &susp->sample_cnt); \ + susp->sample_ptr = susp->sample_block_ptr->samples + +/* susp_took is called after you've taken n samples */ +#define susp_took(sample_cnt, n) susp->sample_cnt -= n + +/* susp_fetch_sample is used to grab just one sample, doesn't check for samples!, + * but applies scale factor: */ +#define susp_fetch_sample(sound, sample_ptr, sample_cnt) \ + (susp->sound->scale * (susp->sample_cnt--, *(susp->sample_ptr++))) + +/* susp_current_sample grabs sample without advancing to next, applies scale + * factor: */ +#define susp_current_sample(sound, sample_ptr) \ + (susp->sound->scale * (*(susp->sample_ptr))) + +/* susp_check_term_samples checks for samples; if new ones are fetched, then + * run termination test on signal and record result. + */ +#define susp_check_term_samples(sound, sample_ptr, sample_cnt) \ + if (susp->sample_cnt == 0) { \ + susp_get_samples(sound, sample_ptr, sample_cnt); \ + terminate_test(sample_ptr, sound, susp->sample_cnt); } + +/* susp_check_term_log_samples checks for samples + * if new ones are fetched, then run termination test and logical stop + * test on signal and record results. + */ +#define susp_check_term_log_samples(sound, sample_ptr, sample_cnt) \ + if (susp->sample_cnt == 0) { \ + susp_get_samples(sound, sample_ptr, sample_cnt); \ + logical_stop_test(sound, susp->sample_cnt); \ + terminate_test(sample_ptr, sound, susp->sample_cnt); } + +/* susp_check_term_log_block_samples checks for samples + * if new ones are fetched, then run termination test and logical stop + * test on signal and record results. In this case, termination and logical + * stop happen at the MAXIMUM of termination and logical stop times, resp. + * + * Originally, this code assumed that logical stops occurred on block boundaries, + * but because of the SET-LOGICAL-STOP function, which just writes a stop time + * into the sound_struct, the logical stop can be anywhere. As soon as the + * logical stop is known, we want to propagate the value from the sound being + * read into the sound being computed. The propagation should set the logical + * stop of the computed sound to the MAX of any current value and the new + * value. When the bit fields indicate that all logical stop times have been + * encountered, then the sound being computed will make the logical stop happen + * on a block boundary and set the flag on the block of samples where the stop + * occurs. + */ +#define susp_check_term_log_block_samples(sound, sample_block_ptr, sample_ptr, sample_cnt, bit, all) \ + if (susp->sample_cnt == 0) { \ + susp_get_block_samples(sound, sample_block_ptr, sample_ptr, sample_cnt); \ +/*OLD if (susp->sound->logical_stop_cnt == \ + susp->sound->current - susp->sample_cnt) { \ +*/ \ + if (susp->sound->logical_stop_cnt != UNKNOWN && \ + !(susp->logical_stop_bits & bit)) { \ + susp->logical_stop_bits |= bit; \ +/*OLD \ + if (susp->logical_stop_bits == all) { \ + susp->susp.log_stop_cnt = (long) \ + ((((susp->sound->current - susp->sample_cnt) / \ + susp->sound->sr + susp->sound->t0) - \ + susp->susp.t0) * susp->susp.sr + 0.5); \ + assert(susp->susp.log_stop_cnt >= 0); } } \ +*/ \ + susp->susp.log_stop_cnt = max(susp->susp.log_stop_cnt, \ + (((susp->sound->logical_stop_cnt / \ + susp->sound->sr + susp->sound->t0) - \ + susp->susp.t0) * susp->susp.sr + 0.5)); } \ + if (susp->sample_ptr == zero_block->samples) { \ + susp->terminate_bits |= bit; \ + if (susp->terminate_bits == all) { \ + susp->terminate_cnt = (long) \ + ((((susp->sound->current - susp->sample_cnt) / \ + susp->sound->sr + susp->sound->t0) - \ + susp->susp.t0) * susp->susp.sr + 0.5); \ + } } } + + +/* logical_stop_cnt_cvt is used to convert from the logical stop count + * at one sample rate to that of another sample rate -- this macro is + * used by the snd_make_<op> routine in every <op>.c file, and assumes + * the target sample rate is susp->susp.sr. + * + * NOTE: this macro does not take into account the possibility of different + * start times - maybe it should. + */ +#define logical_stop_cnt_cvt(sound) \ + (sound->logical_stop_cnt == UNKNOWN ? UNKNOWN : \ + ROUND((sound->logical_stop_cnt / sound->sr) * susp->susp.sr)) + + +/* logical_stop_test tests to see if sound has logically stopped; if so, + * sets susp->susp.log_stop_cnt. The resulting logical_stop_cnt will reflect + * the minimum logical_stop time of all sounds to which this test is applied. + */ +#define logical_stop_test(sound, cnt) \ + if (susp->sound->logical_stop_cnt == susp->sound->current - (cnt)) {\ + min_cnt(&susp->susp.log_stop_cnt, susp->sound, (snd_susp_type) susp, cnt); } + +/* terminate_test checks to see if sound has terminated; if so, + * sets susp->terminate_cnt. The resulting terminate_cnt will reflect + * the minimum termination time of all sounds to which this test is applied. + */ +#define terminate_test(sample_ptr, sound, cnt) \ + if (susp->sample_ptr == zero_block->samples) { \ + min_cnt(&susp->terminate_cnt, susp->sound, (snd_susp_type) susp, cnt); } + + +/* susp_check_log_samples checks for new samples then checks for + * termination and logical stop conditions + */ +#define susp_check_log_samples(sound, sample_ptr, sample_cnt) \ + if (susp->sample_cnt == 0) { \ + susp_get_samples(sound, sample_ptr, sample_cnt); \ + logical_stop_test(sound, susp->sample_cnt); } + +/* susp_check_term_samples_break checks for new samples then checks for + * termination condition; breaks from inner loop + */ +#define susp_check_term_samples_break( \ + sound, sample_ptr, sample_cnt, x2_sample) \ + if (susp->sample_cnt == 0) { \ + susp_get_samples(sound, sample_ptr, sample_cnt); \ + x2_sample = susp_current_sample(sound, sample_ptr); \ + terminate_test(sample_ptr, sound, susp->sample_cnt); \ + if (susp->terminate_cnt < susp->susp.current + cnt + togo) { \ + break; }} \ + else x2_sample = susp_current_sample(sound, sample_ptr); + +/* susp_check_log_samples_break checks for new samples then checks for + * logical stop conditions; breaks from inner loop + */ +#define susp_check_log_samples_break( \ + sound, sample_ptr, sample_cnt, x2_sample) \ + if (susp->sample_cnt == 0) { \ + susp_get_samples(sound, sample_ptr, sample_cnt); \ + x2_sample = susp_current_sample(sound, sample_ptr); \ + logical_stop_test(sound, susp->sample_cnt); \ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN && \ + (susp->susp.log_stop_cnt < susp->susp.current + cnt + togo)) { \ + break; }} \ + else x2_sample = susp_current_sample(sound, sample_ptr); + + +/* susp_check_term_log_samples_break checks for new samples then checks for + * termination and logical stop conditions; breaks from inner loop + */ +#define susp_check_term_log_samples_break( \ + sound, sample_ptr, sample_cnt, x2_sample) \ + if (susp->sample_cnt == 0) { \ + susp_get_samples(sound, sample_ptr, sample_cnt); \ + x2_sample = susp_current_sample(sound, sample_ptr); \ + terminate_test(sample_ptr, sound, susp->sample_cnt); \ + logical_stop_test(sound, susp->sample_cnt); \ + if ((susp->terminate_cnt != UNKNOWN && \ + susp->terminate_cnt < susp->susp.current + cnt + togo) || \ + (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN && \ + susp->susp.log_stop_cnt < susp->susp.current + cnt + togo)) { \ + break; }} \ + else x2_sample = susp_current_sample(sound, sample_ptr); + + diff --git a/nyqsrc/stats.c b/nyqsrc/stats.c new file mode 100644 index 0000000..7f21612 --- /dev/null +++ b/nyqsrc/stats.c @@ -0,0 +1,27 @@ +/* + * stats.c + * + * produce statistics. + */ +#include "switches.h" +#include <stdio.h> +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" + + +void stats() +{ + nyquist_printf("\n\nNyquist statistics:\n\n"); + nyquist_printf("Memory usage:\n"); + nyquist_printf("\tconsumed %d pools of size %d\n", npools, MAXPOOLSIZE); + nyquist_printf("\tdata structure usage:\n"); + nyquist_printf("\t\tsounds\t%d\n", sound_used); + nyquist_printf("\t\tsnd lists\t%d\n", snd_list_used); + nyquist_printf("\t\tsample blocks\t%d\n", sample_block_used); + nyquist_printf("\t\ttable space in bytes\t%ld\n", table_memory); + nyquist_printf("\n"); +} diff --git a/nyqsrc/stdefs.h b/nyqsrc/stdefs.h new file mode 100644 index 0000000..9eba22c --- /dev/null +++ b/nyqsrc/stdefs.h @@ -0,0 +1,49 @@ +/* stdefs.h */ + +#ifndef TRUE +#define TRUE 1 +#endif + +#ifndef FALSE +#define FALSE 0 +#endif + +#ifndef PI +#define PI (3.14159265358979323846) +#endif + +#ifndef PI2 +#define PI2 (6.28318530717958647693) +#endif + +#define D2R (0.01745329348) /* (2*pi)/360 */ +#define R2D (57.29577951) /* 360/(2*pi) */ + +#ifndef MAX +#define MAX(x,y) ((x)>(y) ?(x):(y)) +#endif +#ifndef MIN +#define MIN(x,y) ((x)<(y) ?(x):(y)) +#endif + +#ifndef ABS +#define ABS(x) ((x)<0 ?(-(x)):(x)) +#endif + +#ifndef SGN +#define SGN(x) ((x)<0 ?(-1):((x)==0?(0):(1))) +#endif + +typedef float mem_float; +typedef double fast_float; + +/* I took out this typedef because the same thing + * exists in cext.h which causes a conflict: -RBD +typedef unsigned char boolean; */ + +#include "cext.h" + +#define true 1 +#define false 0 + + diff --git a/nyqsrc/trigger.c b/nyqsrc/trigger.c new file mode 100644 index 0000000..f55ba95 --- /dev/null +++ b/nyqsrc/trigger.c @@ -0,0 +1,326 @@ +/* trigger.c -- return zero until input transitions from <=0 to >0, then + evaluate a closure to get a signal and convert to an add + of the new signal and a copy of this trigger object. + The sample rate of the output is the sample rate of the input, and + sounds returned by the closure must also have a matching sample rate. + The trigger will take place on the first input sample (zero delay) if the + first sample of the input is >0. + The input scale factor is assumed to be 1, so caller should force scaling + especially if the scale factor is negative (!) + The trigger terminates when the input signal terminates (but any adds + continue to run until all their inputs terminate). + +Some implementation notes: + +The closure gets evaluated at the time of the positive sample. +When the positive sample is encountered, first close off the +current output block. + +Next, evaluate the closure, clone the trigger, and convert +the current trigger to an add. The next fetch will therefore +go to the add susp and it will add the closure result to the +zeros that continue to be generated by (a clone of) the trigger. +It would be simple if we could back the clone up one sample: +on the first call to the add, it will ask for samples from the +trigger clone and the closure, but the trigger clone has already +processed the positive sample, so it is one sample ahead of +everyone else. Since we've just read a sample, we CAN back up +just by carefully updating the input pointer to one less than +we actually read, forcing a reread later. (We'll still store +the previous value so re-reading will not re-trigger.) +*/ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 13Dec06 rbd created from sndseq.c + */ + +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "scale.h" +#include "add.h" +#include "extern.h" +#include "cext.h" +#include "assert.h" + +#define TRIGGERDBG 0 +#define D if (TRIGGERDBG) + +/* Note: this structure is identical to an add_susp structure up + to the field output_per_s2 so that we can convert this into + an add after eval'ing the closure. Since this struct is bigger + than an add, make sure not to clobber the "free" routine + (trigger_free) or else we'll leak memory. + */ +typedef struct trigger_susp_struct { + snd_susp_node susp; + boolean started; + int terminate_bits; + long terminate_cnt; + int logical_stop_bits; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_type s1_bptr; /* block pointer */ + sample_block_values_type s1_ptr; + sound_type s2; + long s2_cnt; + sample_block_type s2_bptr; /* block pointer */ + sample_block_values_type s2_ptr; + + /* trigger-specific data starts here */ + sample_type previous; + LVAL closure; + +} trigger_susp_node, *trigger_susp_type; + + +void trigger_fetch(trigger_susp_type, snd_list_type); +void trigger_free(); + +extern LVAL s_stdout; + +void trigger_mark(trigger_susp_type susp) +{ + sound_xlmark(susp->s1); + if (susp->closure) mark(susp->closure); +} + + + +/* trigger_fetch returns zero blocks until s1 goes from <=0 to >0 */ +/**/ +void trigger_fetch(trigger_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + register sample_block_values_type out_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "trigger_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + while (cnt < max_sample_block_len) { /* outer loop */ + /* first compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block */ + togo = max_sample_block_len - cnt; + + /* don't run past the input sample block: */ + susp_check_term_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo) { + togo = susp->terminate_cnt - (susp->susp.current + cnt); + if (togo == 0) break; + } + + n = togo; + input_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + sample_type s = *input_ptr_reg++; + if (susp->previous <= 0 && s > 0) { + trigger_susp_type new_trigger; + sound_type new_trigger_snd; + LVAL result; + long delay; /* sample delay to s2 */ + time_type now; + + susp->previous = s; /* don't retrigger */ + + /**** close off block ****/ + togo = togo - n; + susp->s1_ptr += togo; + susp_took(s1_cnt, togo); + cnt += togo; + snd_list->block_len = cnt; + susp->susp.current += cnt; + now = susp->susp.t0 + susp->susp.current / susp->susp.sr; + + /**** eval closure and add result ****/ +D nyquist_printf("trigger_fetch: about to eval closure at %g, " + "susp->susp.t0 %g, susp.current %d:\n", + now, susp->susp.t0, (int)susp->susp.current); + xlsave1(result); + result = xleval(cons(susp->closure, consa(cvflonum(now)))); + if (exttypep(result, a_sound)) { + susp->s2 = sound_copy(getsound(result)); +D nyquist_printf("trigger: copied result from closure is %p\n", + susp->s2); + } else xlerror("closure did not return a (monophonic) sound", + result); +D nyquist_printf("in trigger: after evaluation; " + "%p returned from evform\n", + susp->s2); + result = NIL; + + /**** cloan this trigger to become s1 ****/ + falloc_generic(new_trigger, trigger_susp_node, + "new_trigger"); + memcpy(new_trigger, susp, sizeof(trigger_susp_node)); + /* don't copy s2 -- it should only be referenced by add */ + new_trigger->s2 = NULL; + new_trigger_snd = sound_create((snd_susp_type) new_trigger, + now, susp->susp.sr, 1.0F); + susp->s1 = new_trigger_snd; + /* add will have to ask new_trigger for samples, new_trigger + * will continue reading samples from s1 (the original input) + */ + susp->s1_cnt = 0; + susp->s1_ptr = NULL; + + /**** convert to add ****/ + susp->susp.mark = add_mark; + /* logical stop will be recomputed by add: */ + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.print_tree = add_print_tree; + + /* assume sample rates are the same */ + if (susp->s1->sr != susp->s2->sr) + xlfail("in trigger: sample rates must match"); + + /* take care of scale factor, if any */ + if (susp->s2->scale != 1.0) { + // stdputstr("normalizing next sound in a seq\n"); + susp->s2 = snd_make_normalize(susp->s2); + } + + /* figure out which add fetch routine to use */ + delay = ROUND((susp->s2->t0 - now) * susp->s1->sr); + if (delay > 0) { /* fill hole between s1 and s2 */ + D stdputstr("using add_s1_nn_fetch\n"); + susp->susp.fetch = add_s1_nn_fetch; + susp->susp.name = "trigger:add_s1_nn_fetch"; + } else { + susp->susp.fetch = add_s1_s2_nn_fetch; + susp->susp.name = "trigger:add_s1_s2_nn_fetch"; + } + +D stdputstr("in trigger: calling add's fetch\n"); + /* fetch will get called later .. + (*(susp->susp.fetch))(susp, snd_list); */ +D stdputstr("in trigger: returned from add's fetch\n"); + xlpop(); + + susp->closure = NULL; /* allow garbage collection now */ + /**** calculation tree modified, time to exit ****/ + /* but if cnt == 0, then we haven't computed any samples */ + /* call on new fetch routine to get some samples */ + if (cnt == 0) { + ffree_sample_block(out, "trigger-pre-adder"); // because adder will reallocate + (*susp->susp.fetch)(susp, snd_list); + } + return; + } else { + susp->previous = s; + /* output zero until ready to add in closure */ + *out_ptr_reg++ = 0; + } + } while (--n); /* inner loop */ + + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + cnt += togo; + } /* outer loop */ + + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } +} /* trigger_fetch */ + + +void trigger_free(trigger_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->s2); + ffree_generic(susp, sizeof(trigger_susp_node), "trigger_free"); +} + + +void trigger_print_tree(trigger_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("closure:"); + stdprint(susp->closure); + + indent(n); + stdputstr("s2:"); + sound_print_tree_1(susp->s2, n); +} + + + + +sound_type snd_make_trigger(s1, closure) + sound_type s1; + LVAL closure; +{ + register trigger_susp_type susp; + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + sound_type result; + + xlprot1(closure); + falloc_generic(susp, trigger_susp_node, "snd_make_trigger"); + + if (s1->scale != 1.0) { + /* stdputstr("normalizing first sound in a seq\n"); */ + s1 = snd_make_normalize(s1); + } + + susp->susp.fetch = trigger_fetch; + + susp->terminate_cnt = UNKNOWN; + susp->terminate_bits = 0; /* bits for s1 and s2 termination */ + susp->logical_stop_bits = 0; /* bits for s1 and s2 logical stop */ + + /* initialize susp state */ + susp->susp.free = trigger_free; + susp->susp.sr = s1->sr; + susp->susp.t0 = s1->t0; + susp->susp.mark = trigger_mark; + susp->susp.print_tree = trigger_print_tree; + susp->susp.name = "trigger"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = s1->logical_stop_cnt; + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->s2 = NULL; + susp->s2_cnt = 0; + susp->closure = closure; + susp->previous = 0; + result = sound_create((snd_susp_type)susp, susp->susp.t0, susp->susp.sr, scale_factor); + xlpopn(1); + return result; +} + + +sound_type snd_trigger(s1, closure) + sound_type s1; + LVAL closure; +{ + sound_type s1_copy; + s1_copy = sound_copy(s1); + return snd_make_trigger(s1_copy, closure); +} diff --git a/nyqsrc/trigger.h b/nyqsrc/trigger.h new file mode 100644 index 0000000..d300e92 --- /dev/null +++ b/nyqsrc/trigger.h @@ -0,0 +1,3 @@ +sound_type snd_make_trigger(); +sound_type snd_trigger(); + /* LISP: (SND-TRIGGER SOUND ANY) */ diff --git a/nyqsrc/yin.c b/nyqsrc/yin.c new file mode 100644 index 0000000..b034c4d --- /dev/null +++ b/nyqsrc/yin.c @@ -0,0 +1,579 @@ +#include "stdio.h" +#ifdef UNIX +#include "sys/file.h" +#endif +#ifndef mips +#include "stdlib.h" +#endif +#include "sndfmt.h" +#include "xlisp.h" +#include "sound.h" +#include "falloc.h" +#include "yin.h" + + +void yin_free(); + +/* for multiple channel results, one susp is shared by all sounds */ +/* the susp in turn must point back to all sound list tails */ + +typedef struct yin_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + long blocksize; + long stepsize; + sample_type *block; + float *temp; + sample_type *fillptr; + sample_type *endptr; + snd_list_type chan[2]; /* array of back pointers */ + long cnt; /* how many sample frames to read */ + long m; + long middle; +} yin_susp_node, *yin_susp_type; + +/* DEBUG CODE: + * use this to print the sound created by yin + +sound_type ysnd[2]; + +void print_ysnds(char *label, yin_susp_type susp) +{ + int i; + printf("At %s:\n", label); + for (i = 0; i < 2; i++) { + snd_list_type snd_list; + if (!susp->chan[i]) continue; + snd_list = ysnd[i]->list; + printf(" ysnd[%d]:\n", i, label); + while (true) { + printf(" snd_list %p block %p\n", snd_list, snd_list->block); + if (snd_list == zero_snd_list) { + printf(" (zero_snd_list)\n"); + break; + } else if (!snd_list->block) { + printf(" susp %p (%s)\n", snd_list->u.susp, + snd_list->u.susp->name); + break; + } + snd_list = snd_list->u.next; + } + } + printf(" susp->chan[0] = %p, susp->chan[1] = %p\n", + susp->chan[0], susp->chan[1]); + +} + * END OF DEBUG CODE + */ + +// Uses cubic interpolation to return the value of x such +// that the function defined by f(0), f(1), f(2), and f(3) +// is maximized. +// +float CubicMaximize(float y0, float y1, float y2, float y3) +{ + // Find coefficients of cubic + + float a, b, c, d; + float da, db, dc; + float discriminant; + float x1, x2; + float dda, ddb; + + a = (float) (y0/-6.0 + y1/2.0 - y2/2.0 + y3/6.0); + b = (float) (y0 - 5.0*y1/2.0 + 2.0*y2 - y3/2.0); + c = (float) (-11.0*y0/6.0 + 3.0*y1 - 3.0*y2/2.0 + y3/3.0); + d = y0; + + // Take derivative + + da = 3*a; + db = 2*b; + dc = c; + + // Find zeroes of derivative using quadratic equation + + discriminant = db*db - 4*da*dc; + if (discriminant < 0.0) + return -1.0; // error + + x1 = (float) ((-db + sqrt(discriminant)) / (2 * da)); + x2 = (float) ((-db - sqrt(discriminant)) / (2 * da)); + + // The one which corresponds to a local _maximum_ in the + // cubic is the one we want - the one with a negative + // second derivative + + dda = 2*da; + ddb = db; + + if (dda*x1 + ddb < 0) + return x1; + else + return x2; +} + + +float parabolic_interp(float x1, float x2, float x3, float y1, float y2, + float y3, float *min) +{ + float a, b, c; + float pos; + + // y1=a*x1^2+b*x1+c + // y2=a*x2^2+b*x2+c + // y3=a*x3^2+b*x3+c + + // y1-y2=a*(x1^2-x2^2)+b*(x1-x2) + // y2-y3=a*(x2^2-x3^2)+b*(x2-x3) + + // (y1-y2)/(x1-x2)=a*(x1+x2)+b + // (y2-y3)/(x2-x3)=a*(x2+x3)+b + + a = ((y1 - y2) / (x1 - x2) - (y2 - y3) / (x2 - x3)) / (x1 - x3); + b = (y1 - y2) / (x1 - x2) - a * (x1 + x2); + c = y1 - a * x1 * x1 - b * x1; + + // dy/dx = 2a*x + b = 0 + + pos = (float) (-b / (a + a)); + *min = /* ax^2 + bx + c */ (a * pos + b) * pos + c; + return pos; +} + + +void yin_compute(yin_susp_type susp, float *pitch, float *harmonicity) + // samples is a buffer of samples + // n is the number of samples, equals twice longest period, must be even + // m is the shortest period in samples + // results is an array of size n/2 - m + 1, the number of different lags +{ + + float *samples = susp->block; + int middle = susp->middle; + int m = susp->m; + float threshold = 0.1F; + float *results = susp->temp; + + // work from the middle of the buffer: + int i, j; // loop counters + // how many different lags do we compute? + float left_energy = 0; + float right_energy = 0; + float left, right, non_periodic; + float auto_corr=0; + float cum_sum=0.0; + float period; + int min_i; + + // for each window, we keep the energy so we can compute the next one + // incrementally. First, we need to compute the energies for lag m-1: + for (i = 0; i < m - 1; i++) { + left = samples[middle - 1 - i]; + left_energy += left * left; + right = samples[middle + i]; + right_energy += right * right; + } + + for (i = m; i <= middle; i++) { + // i is the lag and the length of the window + // compute the energy for left and right + left = samples[middle - i]; + left_energy += left * left; + right = samples[middle - 1 + i]; + + right_energy += right * right; + // compute the autocorrelation + auto_corr = 0; + for (j = 0; j < i; j++) { + auto_corr += samples[middle - i + j] * samples[middle + j]; + } + non_periodic = (left_energy + right_energy - 2 * auto_corr);// / i; + results[i - m] = non_periodic; + + } + + // normalize by the cumulative sum + for (i = m; i <= middle; i++) { + cum_sum += results[i - m]; + results[i - m]=results[i - m] / (cum_sum / (i - m + 1)); + } + + min_i = m; // value of initial estimate + for (i = m; i <= middle; i++) { + if (results[i - m] < threshold) { + min_i=i; + break; + } else if (results[i - m] < results[min_i - m]) + min_i=i; + } + + // This step is not part of the published algorithm. Just because we + // found a point below the threshold does not mean we are at a local + // minimum. E.g. a sine input will go way below threshold, so the + // period estimate at the threshold crossing will be too low. In this + // step, we continue to scan forward until we reach a local minimum. + while (min_i < middle && results[min_i + 1 - m] < results[min_i - m]) { + min_i++; + } + + // use parabolic interpolation to improve estimate + if (i>m && i<middle) { + period = parabolic_interp((float)(min_i - 1), (float)(min_i), + (float)(min_i + 1), + results[min_i - 1 - m], results[min_i - m], + results[min_i + 1 - m], harmonicity); + } else { + period = (float) min_i; + } + *harmonicity = results[min_i - m]; + *pitch = (float) hz_to_step((float) (susp->susp.sr * susp->stepsize) / period); +} + + +/* yin_fetch - compute F0 and harmonicity using YIN approach. */ +/* + * The pitch (F0) is determined by finding two periods whose + * inner product accounts for almost all of the energy. Let X and Y + * be adjacent vectors of length N in the sample stream. Then, + * if 2X*Y > threshold * (X*X + Y*Y) + * then the period is given by N + * In the algorithm, we compute different sizes until we find a + * peak above threshold. Then, we use cubic interpolation to get + * a precise value. If no peak above threshold is found, we return + * the first peak. The second channel returns the value 2X*Y/(X*X+Y*Y) + * which is refered to as the "harmonicity" -- the amount of energy + * accounted for by periodicity. + * + * Low sample rates are advised because of the high cost of computing + * inner products (fast autocorrelation is not used). + * + * The result is a 2-channel signal running at the requested rate. + * The first channel is the estimated pitch, and the second channel + * is the harmonicity. + * + * This code is adopted from multiread, currently the only other + * multichannel suspension in Nyquist. Comments from multiread include: + * The susp is shared by all channels. The susp has backpointers + * to the tail-most snd_list node of each channel, and it is by + * extending the list at these nodes that sounds are read in. + * To avoid a circularity, the reference counts on snd_list nodes + * do not include the backpointers from this susp. When a snd_list + * node refcount goes to zero, the yin susp's free routine + * is called. This must scan the backpointers to find the node that + * has a zero refcount (the free routine is called before the node + * is deallocated, so this is safe). The backpointer is then set + * to NULL. When all backpointers are NULL, the susp itself is + * deallocated, because it can only be referenced through the + * snd_list nodes to which there are backpointers. + */ +void yin_fetch(yin_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + int togo; + int n; + int i; + sample_block_type f0; + sample_block_values_type f0_ptr = NULL; + sample_block_type harmonicity; + sample_block_values_type harmonicity_ptr = NULL; + + register sample_block_values_type s_ptr_reg; + register sample_type *fillptr_reg; + register sample_type *endptr_reg = susp->endptr; + + /* DEBUG: print_ysnds("top of yin_fetch", susp); */ + if (susp->chan[0]) { + falloc_sample_block(f0, "yin_fetch"); + f0_ptr = f0->samples; + /* Since susp->chan[i] exists, we want to append a block of samples. + * The block, out, has been allocated. Before we insert the block, + * we must figure out whether to insert a new snd_list_type node for + * the block. Recall that before SND_get_next is called, the last + * snd_list_type in the list will have a null block pointer, and the + * snd_list_type's susp field points to the suspension (in this case, + * susp). When SND_get_next (in sound.c) is called, it appends a new + * snd_list_type and points the previous one to internal_zero_block + * before calling this fetch routine. On the other hand, since + * SND_get_next is only going to be called on one of the channels, the + * other channels will not have had a snd_list_type appended. + * SND_get_next does not tell us directly which channel it wants (it + * doesn't know), but we can test by looking for a non-null block in the + * snd_list_type pointed to by our back-pointers in susp->chan[]. If + * the block is null, the channel was untouched by SND_get_next, and + * we should append a snd_list_type. If it is non-null, then it + * points to internal_zero_block (the block inserted by SND_get_next) + * and a new snd_list_type has already been appended. + */ + /* Before proceeding, it may be that garbage collection ran when we + * allocated out, so check again to see if susp->chan[j] is Null: + */ + if (!susp->chan[0]) { + ffree_sample_block(f0, "yin_fetch"); + f0 = NULL; /* make sure we don't free it again */ + f0_ptr = NULL; /* make sure we don't output f0 samples */ + } else if (!susp->chan[0]->block) { + snd_list_type snd_list = snd_list_create((snd_susp_type) susp); + /* printf("created snd_list %x for chan 0 with susp %x\n", + snd_list, snd_list->u.susp); */ + /* Now we have a snd_list to append to the channel, but a very + * interesting thing can happen here. snd_list_create, which + * we just called, MAY have invoked the garbage collector, and + * the GC MAY have freed all references to this channel, in which + * case yin_free(susp) will have been called, and susp->chan[0] + * will now be NULL! + */ + if (!susp->chan[0]) { + ffree_snd_list(snd_list, "yin_fetch"); + } else { + susp->chan[0]->u.next = snd_list; + } + } + /* see the note above: we don't know if susp->chan still exists */ + /* Note: We DO know that susp still exists because even if we lost + * some channels in a GC, someone is still calling SND_get_next on + * some channel. I suppose that there might be some very pathological + * code that could free a global reference to a sound that is in the + * midst of being computed, perhaps by doing something bizarre in the + * closure that snd_seq activates at the logical stop time of its first + * sound, but I haven't thought that one through. + */ + if (susp->chan[0]) { + susp->chan[0]->block = f0; + /* check some assertions */ + if (susp->chan[0]->u.next->u.susp != (snd_susp_type) susp) { + nyquist_printf("didn't find susp at end of list for chan 0\n"); + } + } else if (f0) { /* we allocated f0, but don't need it anymore due to GC */ + ffree_sample_block(f0, "yin_fetch"); + f0_ptr = NULL; + } + } + + /* Now, repeat for channel 1 (comments omitted) */ + if (susp->chan[1]) { + falloc_sample_block(harmonicity, "yin_fetch"); + harmonicity_ptr = harmonicity->samples; + if (!susp->chan[1]) { + ffree_sample_block(harmonicity, "yin_fetch"); + harmonicity = NULL; /* make sure we don't free it again */ + harmonicity_ptr = NULL; + } else if (!susp->chan[1]->block) { + snd_list_type snd_list = snd_list_create((snd_susp_type) susp); + /* printf("created snd_list %x for chan 1 with susp %x\n", + snd_list, snd_list->u.susp); */ + if (!susp->chan[1]) { + ffree_snd_list(snd_list, "yin_fetch"); + } else { + susp->chan[1]->u.next = snd_list; + } + } + if (susp->chan[1]) { + susp->chan[1]->block = harmonicity; + if (susp->chan[1]->u.next->u.susp != (snd_susp_type) susp) { + nyquist_printf("didn't find susp at end of list for chan 1\n"); + } + } else if (harmonicity) { /* we allocated harmonicity, but don't need it anymore due to GC */ + ffree_sample_block(harmonicity, "yin_fetch"); + harmonicity_ptr = NULL; + } + } + + /* DEBUG: print_ysnds("yin_fetch before outer loop", susp); */ + while (cnt < max_sample_block_len) { /* outer loop */ + /* first, compute how many samples to generate in inner loop: */ + /* don't overflow the output sample block */ + togo = (max_sample_block_len - cnt) * susp->stepsize; + + /* don't run past the s input sample block */ + susp_check_term_log_samples(s, s_ptr, s_cnt); + togo = min(togo, susp->s_cnt); + + /* don't run past terminate time */ + if (susp->terminate_cnt != UNKNOWN && + susp->terminate_cnt <= susp->susp.current + cnt + togo/susp->stepsize) { + togo = (susp->terminate_cnt - (susp->susp.current + cnt)) * susp->stepsize; + if (togo == 0) break; + } + + /* don't run past logical stop time */ + if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) { + int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt); + /* break if to_stop = 0 (we're at the logical stop) + * AND cnt > 0 (we're not at the beginning of the output block) + */ + if (to_stop < togo/susp->stepsize) { + if (to_stop == 0) { + if (cnt) { + togo = 0; + break; + } else /* keep togo as is: since cnt == 0, we can set + * the logical stop flag on this output block + */ + susp->logically_stopped = true; + } else /* limit togo so we can start a new block a the LST */ + togo = to_stop * susp->stepsize; + } + } + n = togo; + s_ptr_reg = susp->s_ptr; + fillptr_reg = susp->fillptr; + if (n) do { /* the inner sample computation loop */ + *fillptr_reg++ = *s_ptr_reg++; + if (fillptr_reg >= endptr_reg) { + float f0; + float harmonicity; + yin_compute(susp, &f0, &harmonicity); + if (f0_ptr) *f0_ptr++ = f0; + if (harmonicity_ptr) *harmonicity_ptr++ = harmonicity; + cnt++; + // shift block by stepsize + memmove(susp->block, susp->block + susp->stepsize, + sizeof(sample_type) * (susp->blocksize - susp->stepsize)); + fillptr_reg -= susp->stepsize; + } + } while (--n); /* inner loop */ + + /* using s_ptr_reg is a bad idea on RS/6000: */ + susp->s_ptr += togo; + susp->fillptr = fillptr_reg; + susp_took(s_cnt, togo); + } /* outer loop */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + /* single channels code: snd_list_terminate(snd_list); */ + for (i = 0; i < 2; i++) { + if (susp->chan[i]) { + snd_list_type the_snd_list = susp->chan[i]; + susp->chan[i] = the_snd_list->u.next; + snd_list_terminate(the_snd_list); + } + } + } else { + /* single channel code: + snd_list->block_len = cnt; + */ + susp->susp.current += cnt; + for (i = 0; i < 2; i++) { + if (susp->chan[i]) { + susp->chan[i]->block_len = cnt; + susp->chan[i] = susp->chan[i]->u.next; + } + } + } + + /* test for logical stop */ + if (susp->logically_stopped) { + /* single channel code: snd_list->logically_stopped = true; */ + if (susp->chan[0]) susp->chan[0]->logically_stopped = true; + if (susp->chan[1]) susp->chan[1]->logically_stopped = true; + } else if (susp->susp.log_stop_cnt == susp->susp.current) { + susp->logically_stopped = true; + } +} /* yin_fetch */ + + +void yin_mark(yin_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void yin_free(yin_susp_type susp) +{ + int j; + boolean active = false; +/* stdputstr("yin_free: "); */ + + for (j = 0; j < 2; j++) { + if (susp->chan[j]) { + if (susp->chan[j]->refcnt) active = true; + else { + susp->chan[j] = NULL; + /* nyquist_printf("deactivating channel %d\n", j); */ + } + } + } + if (!active) { +/* stdputstr("all channels freed, freeing susp now\n"); */ + ffree_generic(susp, sizeof(yin_susp_node), "yin_free"); + sound_unref(susp->s); + free(susp->block); + free(susp->temp); + } +} + + +void yin_print_tree(yin_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +LVAL snd_make_yin(sound_type s, double low_step, double high_step, long stepsize) +{ + LVAL result; + int j; + register yin_susp_type susp; + rate_type sr = s->sr; + time_type t0 = s->t0; + + falloc_generic(susp, yin_susp_node, "snd_make_yin"); + susp->susp.fetch = yin_fetch; + susp->terminate_cnt = UNKNOWN; + + /* initialize susp state */ + susp->susp.free = yin_free; + susp->susp.sr = sr / stepsize; + susp->susp.t0 = t0; + susp->susp.mark = yin_mark; + susp->susp.print_tree = yin_print_tree; + susp->susp.name = "yin"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s); + susp->susp.current = 0; + susp->s = s; + susp->s_cnt = 0; + susp->m = (long) (sr / step_to_hz(high_step)); + if (susp->m < 2) susp->m = 2; + /* add 1 to make sure we round up */ + susp->middle = (long) (sr / step_to_hz(low_step)) + 1; + susp->blocksize = susp->middle * 2; + susp->stepsize = stepsize; + /* blocksize must be at least step size to implement stepping */ + if (susp->stepsize > susp->blocksize) susp->blocksize = susp->stepsize; + susp->block = (sample_type *) malloc(susp->blocksize * sizeof(sample_type)); + susp->temp = (float *) malloc((susp->middle - susp->m + 1) * sizeof(float)); + susp->fillptr = susp->block; + susp->endptr = susp->block + susp->blocksize; + + xlsave1(result); + + result = newvector(2); /* create array for F0 and harmonicity */ + /* create sounds to return */ + for (j = 0; j < 2; j++) { + sound_type snd = sound_create((snd_susp_type)susp, + susp->susp.t0, susp->susp.sr, 1.0); + LVAL snd_lval = cvsound(snd); +/* nyquist_printf("yin_create: sound %d is %x, LVAL %x\n", j, snd, snd_lval); */ + setelement(result, j, snd_lval); + susp->chan[j] = snd->list; + /* DEBUG: ysnd[j] = snd; */ + } + xlpop(); + return result; +} + + +LVAL snd_yin(sound_type s, double low_step, double high_step, long stepsize) +{ + sound_type s_copy = sound_copy(s); + return snd_make_yin(s_copy, low_step, high_step, stepsize); +} diff --git a/nyqsrc/yin.h b/nyqsrc/yin.h new file mode 100644 index 0000000..656aa81 --- /dev/null +++ b/nyqsrc/yin.h @@ -0,0 +1,6 @@ +/* yin.h -- Nyquist code for F0 estimation using YIN approach */ + + +LVAL snd_yin(sound_type s, double low_step, double high_step, long stepsize); +/* LISP: (SND-YIN SOUND ANYNUM ANYNUM FIXNUM) */ + |