diff options
Diffstat (limited to 'tran')
253 files changed, 36234 insertions, 0 deletions
diff --git a/tran/abs.alg b/tran/abs.alg new file mode 100644 index 0000000..2c139e6 --- /dev/null +++ b/tran/abs.alg @@ -0,0 +1,9 @@ +(ABS-ALG + (NAME "abs") + (ARGUMENTS ("sound_type" "input")) + (ALWAYS-SCALE input) + (START (MIN input)) + (INNER-LOOP "{ sample_type s = input; sample_type o = s; if (o < 0.0) o = -o; output = o; }") + (TERMINATE (MIN input)) + (LOGICAL-STOP (MIN input)) +) diff --git a/tran/abs.c b/tran/abs.c new file mode 100644 index 0000000..130d185 --- /dev/null +++ b/tran/abs.c @@ -0,0 +1,198 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "abs.h" + +void abs_free(); + + +typedef struct abs_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; +} abs_susp_node, *abs_susp_type; + + +void abs_s_fetch(register abs_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 input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "abs_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ sample_type s = (input_scale_reg * *input_ptr_reg++); sample_type o = s; if (o < 0.0) o = -o; *out_ptr_reg++ = o; }; + } while (--n); /* inner loop */ + + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* abs_s_fetch */ + + +void abs_toss_fetch(susp, snd_list) + register abs_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void abs_mark(abs_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void abs_free(abs_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(abs_susp_node), "abs_free"); +} + + +void abs_print_tree(abs_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_abs(sound_type input) +{ + register abs_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, abs_susp_node, "snd_make_abs"); + susp->susp.fetch = abs_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = abs_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = abs_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = abs_mark; + susp->susp.print_tree = abs_print_tree; + susp->susp.name = "abs"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_abs(sound_type input) +{ + sound_type input_copy = sound_copy(input); + return snd_make_abs(input_copy); +} diff --git a/tran/abs.h b/tran/abs.h new file mode 100644 index 0000000..04b8d78 --- /dev/null +++ b/tran/abs.h @@ -0,0 +1,3 @@ +sound_type snd_make_abs(sound_type input); +sound_type snd_abs(sound_type input); + /* LISP: (snd-abs SOUND) */ diff --git a/tran/allpoles.alg b/tran/allpoles.alg new file mode 100644 index 0000000..ab29850 --- /dev/null +++ b/tran/allpoles.alg @@ -0,0 +1,70 @@ +(ALLPOLES-ALG +(NAME "allpoles") +(ARGUMENTS ("sound_type" "x_snd")("LVAL" "ak_array")("double" "gain")) +(START (MIN x_snd)) +(NOT-IN-INNER-LOOP "ak_array") +(ALWAYS-SCALE x_snd) +(TERMINATE (MIN x_snd)) +(LOGICAL-STOP (MIN x_snd)) + +(STATE + ("long" "ak_len" "0") ; length of coefs ak array + ("LVAL" "ak_array" "ak_array") + ("double" "gain" "gain") + ("double *" "ak_coefs" "NULL") ; coefs array + ("double *" "zk_buf" "NULL") ; last values of output + ("long" "index" "0") +) + +(OUTER-LOOP " + if (susp->ak_array == NULL) { + togo = 0; /* indicate termination */ + break; /* we're done */ + } + else if (!vectorp(susp->ak_array)) + xlerror(\"array expected\", susp->ak_array); + else if (susp->ak_coefs == NULL) + { + long i; + susp->ak_len = getsize(susp->ak_array); + if (susp->ak_len < 1) xlerror(\"array has not elements\", susp->ak_array); + susp->ak_coefs = (double *) calloc(susp->ak_len, sizeof(double)); + susp->zk_buf = (double *) calloc(susp->ak_len, sizeof(double)); + + /* at this point we have a new array and a place to put ak coefs */ + for(i=0; i < susp->ak_len; i++) { + LVAL elem = getelement(susp->ak_array,i); + if (ntype(elem) != FLONUM) { + xlerror(\"flonum expected\", elem); + } + susp->ak_coefs[i] = getflonum(elem); + } + + } +") + + +(CONSTANT "ak_array" "ak_coefs" "ak_len" "gain") +(SAMPLE-RATE "x_snd->sr") +(INNER-LOOP-LOCALS "double z0; long xi; long xj;") + +(INNER-LOOP " + z0 = x_snd*gain; + for (xi=0; xi < ak_len ; xi++) + { + xj = index + xi; if (xj >= ak_len) xj -= ak_len; + z0 += ak_coefs[xi] * zk_buf[xj]; + } + zk_buf[index] = z0; + index++; if (index == ak_len) index = 0; + output = (sample_type) z0; +") + +(FINALIZATION " + free(susp->zk_buf); + free(susp->ak_coefs); + susp->ak_array = NULL; /* free array */ +") +) + + diff --git a/tran/allpoles.c b/tran/allpoles.c new file mode 100644 index 0000000..39e47a5 --- /dev/null +++ b/tran/allpoles.c @@ -0,0 +1,264 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "allpoles.h" + +void allpoles_free(); + + +typedef struct allpoles_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; + + long ak_len; + LVAL ak_array; + double gain; + double *ak_coefs; + double *zk_buf; + long index; +} allpoles_susp_node, *allpoles_susp_type; + + +void allpoles_s_fetch(register allpoles_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 long ak_len_reg; + register double gain_reg; + register double * ak_coefs_reg; + register double * zk_buf_reg; + register long index_reg; + register sample_type x_snd_scale_reg = susp->x_snd->scale; + register sample_block_values_type x_snd_ptr_reg; + falloc_sample_block(out, "allpoles_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: */ + susp_check_term_log_samples(x_snd, x_snd_ptr, x_snd_cnt); + 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; + } + } + + + if (susp->ak_array == NULL) { + togo = 0; /* indicate termination */ + break; /* we're done */ + } + else if (!vectorp(susp->ak_array)) + xlerror("array expected", susp->ak_array); + else if (susp->ak_coefs == NULL) + { + long i; + susp->ak_len = getsize(susp->ak_array); + if (susp->ak_len < 1) xlerror("array has not elements", susp->ak_array); + susp->ak_coefs = (double *) calloc(susp->ak_len, sizeof(double)); + susp->zk_buf = (double *) calloc(susp->ak_len, sizeof(double)); + + /* at this point we have a new array and a place to put ak coefs */ + for(i=0; i < susp->ak_len; i++) { + LVAL elem = getelement(susp->ak_array,i); + if (ntype(elem) != FLONUM) { + xlerror("flonum expected", elem); + } + susp->ak_coefs[i] = getflonum(elem); + } + + } + + n = togo; + ak_len_reg = susp->ak_len; + gain_reg = susp->gain; + ak_coefs_reg = susp->ak_coefs; + zk_buf_reg = susp->zk_buf; + index_reg = susp->index; + x_snd_ptr_reg = susp->x_snd_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +double z0; long xi; long xj; + z0 = (x_snd_scale_reg * *x_snd_ptr_reg++)*gain_reg; + for (xi=0; xi < ak_len_reg ; xi++) + { + xj = index_reg + xi; if (xj >= ak_len_reg) xj -= ak_len_reg; + z0 += ak_coefs_reg[xi] * zk_buf_reg[xj]; + } + zk_buf_reg[index_reg] = z0; + index_reg++; if (index_reg == ak_len_reg) index_reg = 0; + *out_ptr_reg++ = (sample_type) z0; +; + } while (--n); /* inner loop */ + + susp->zk_buf = zk_buf_reg; + susp->index = index_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; + } +} /* allpoles_s_fetch */ + + +void allpoles_toss_fetch(susp, snd_list) + register allpoles_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + 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 allpoles_mark(allpoles_susp_type susp) +{ + if (susp->ak_array) mark(susp->ak_array); + sound_xlmark(susp->x_snd); +} + + +void allpoles_free(allpoles_susp_type susp) +{ + + free(susp->zk_buf); + free(susp->ak_coefs); + susp->ak_array = NULL; /* free array */ + sound_unref(susp->x_snd); + ffree_generic(susp, sizeof(allpoles_susp_node), "allpoles_free"); +} + + +void allpoles_print_tree(allpoles_susp_type susp, int n) +{ + indent(n); + stdputstr("x_snd:"); + sound_print_tree_1(susp->x_snd, n); +} + + +sound_type snd_make_allpoles(sound_type x_snd, LVAL ak_array, double gain) +{ + register allpoles_susp_type susp; + rate_type sr = x_snd->sr; + time_type t0 = x_snd->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, allpoles_susp_node, "snd_make_allpoles"); + susp->ak_len = 0; + susp->ak_array = ak_array; + susp->gain = gain; + susp->ak_coefs = NULL; + susp->zk_buf = NULL; + susp->index = 0; + susp->susp.fetch = allpoles_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 = allpoles_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = allpoles_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = allpoles_mark; + susp->susp.print_tree = allpoles_print_tree; + susp->susp.name = "allpoles"; + 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_allpoles(sound_type x_snd, LVAL ak_array, double gain) +{ + sound_type x_snd_copy = sound_copy(x_snd); + return snd_make_allpoles(x_snd_copy, ak_array, gain); +} diff --git a/tran/allpoles.h b/tran/allpoles.h new file mode 100644 index 0000000..aadcc65 --- /dev/null +++ b/tran/allpoles.h @@ -0,0 +1,3 @@ +sound_type snd_make_allpoles(sound_type x_snd, LVAL ak_array, double gain); +sound_type snd_allpoles(sound_type x_snd, LVAL ak_array, double gain); + /* LISP: (snd-allpoles SOUND ANY ANYNUM) */ diff --git a/tran/alpass.alg b/tran/alpass.alg new file mode 100644 index 0000000..99d8eb9 --- /dev/null +++ b/tran/alpass.alg @@ -0,0 +1,22 @@ +(ALPASS-ALG +(NAME "alpass") +(ARGUMENTS ("sound_type" "input") ("time_type" "delay") ("double" "feedback")) +(START (MIN input)) +(STATE ("double" "feedback" "feedback") + ("long" "delaylen" "max(1, round(input->sr * delay))") + ("sample_type *" "delaybuf" + "(sample_type *) calloc (susp->delaylen, sizeof(sample_type))") + ("sample_type *" "delayptr" "susp->delaybuf") + ("sample_type *" "endptr" "susp->delaybuf + susp->delaylen")) +(CONSTANT "feedback" "delaylen" "endptr") +(NOT-REGISTER delaybuf) +(LINEAR input) +(TERMINATE (MIN input)) +(INNER-LOOP-LOCALS "register sample_type y, z;\n") +(INNER-LOOP " y = *delayptr; + *delayptr++ = z = (sample_type) (feedback * y + input); + output = (sample_type) (y - feedback * z); + if (delayptr >= endptr) delayptr = susp->delaybuf;") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/alpass.c b/tran/alpass.c new file mode 100644 index 0000000..cad43ef --- /dev/null +++ b/tran/alpass.c @@ -0,0 +1,193 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "alpass.h" + +void alpass_free(); + + +typedef struct alpass_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + double feedback; + long delaylen; + sample_type *delaybuf; + sample_type *delayptr; + sample_type *endptr; +} alpass_susp_node, *alpass_susp_type; + + +void alpass_n_fetch(register alpass_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 double feedback_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpass_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 input input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + feedback_reg = susp->feedback; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +register sample_type y, z; + y = *delayptr_reg; + *delayptr_reg++ = z = (sample_type) (feedback_reg * y + *input_ptr_reg++); + *out_ptr_reg++ = (sample_type) (y - feedback_reg * z); + if (delayptr_reg >= endptr_reg) delayptr_reg = susp->delaybuf;; + } while (--n); /* inner loop */ + + susp->delayptr = delayptr_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* alpass_n_fetch */ + + +void alpass_toss_fetch(susp, snd_list) + register alpass_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void alpass_mark(alpass_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void alpass_free(alpass_susp_type susp) +{ +free(susp->delaybuf); sound_unref(susp->input); + ffree_generic(susp, sizeof(alpass_susp_node), "alpass_free"); +} + + +void alpass_print_tree(alpass_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_alpass(sound_type input, time_type delay, double feedback) +{ + register alpass_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, alpass_susp_node, "snd_make_alpass"); + susp->feedback = feedback; + susp->delaylen = max(1, round(input->sr * delay)); + susp->delaybuf = (sample_type *) calloc (susp->delaylen, sizeof(sample_type)); + susp->delayptr = susp->delaybuf; + susp->endptr = susp->delaybuf + susp->delaylen; + susp->susp.fetch = alpass_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = alpass_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = alpass_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = alpass_mark; + susp->susp.print_tree = alpass_print_tree; + susp->susp.name = "alpass"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_alpass(sound_type input, time_type delay, double feedback) +{ + sound_type input_copy = sound_copy(input); + return snd_make_alpass(input_copy, delay, feedback); +} diff --git a/tran/alpass.h b/tran/alpass.h new file mode 100644 index 0000000..a526d1f --- /dev/null +++ b/tran/alpass.h @@ -0,0 +1,3 @@ +sound_type snd_make_alpass(sound_type input, time_type delay, double feedback); +sound_type snd_alpass(sound_type input, time_type delay, double feedback); + /* LISP: (snd-alpass SOUND ANYNUM ANYNUM) */ diff --git a/tran/alpasscv.alg b/tran/alpasscv.alg new file mode 100644 index 0000000..ba1602a --- /dev/null +++ b/tran/alpasscv.alg @@ -0,0 +1,21 @@ +(ALPASSCV-ALG +(NAME "alpasscv") +(ARGUMENTS ("sound_type" "input") ("time_type" "delay") ("sound_type" "feedback")) +(START (MAX input feedback)) +(STATE ("long" "delaylen" "max(1, round(input->sr * delay))") + ("sample_type *" "delaybuf" + "(sample_type *) calloc (susp->delaylen, sizeof(sample_type))") + ("sample_type *" "delayptr" "susp->delaybuf") + ("sample_type *" "endptr" "susp->delaybuf + susp->delaylen")) +(CONSTANT "delaylen" "endptr") +(NOT-REGISTER delaybuf) +(LINEAR input) +(TERMINATE (MIN input)) +(INNER-LOOP-LOCALS "register sample_type y, z, fb;\n") +(INNER-LOOP " y = *delayptr; + *delayptr++ = z = (sample_type) ((fb = feedback) * y + input); + output = (sample_type) (y - fb * z); + if (delayptr >= endptr) delayptr = susp->delaybuf;") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/alpasscv.c b/tran/alpasscv.c new file mode 100644 index 0000000..99c4855 --- /dev/null +++ b/tran/alpasscv.c @@ -0,0 +1,302 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "alpasscv.h" + +void alpasscv_free(); + + +typedef struct alpasscv_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + sound_type feedback; + long feedback_cnt; + sample_block_values_type feedback_ptr; + + long delaylen; + sample_type *delaybuf; + sample_type *delayptr; + sample_type *endptr; +} alpasscv_susp_node, *alpasscv_susp_type; + + +void alpasscv_nn_fetch(register alpasscv_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 * delayptr_reg; + register sample_type * endptr_reg; + register sample_block_values_type feedback_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpasscv_nn_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +register sample_type y, z, fb; + y = *delayptr_reg; + *delayptr_reg++ = z = (sample_type) ((fb = *feedback_ptr_reg++) * y + *input_ptr_reg++); + *out_ptr_reg++ = (sample_type) (y - fb * z); + if (delayptr_reg >= endptr_reg) delayptr_reg = susp->delaybuf;; + } while (--n); /* inner loop */ + + susp->delayptr = delayptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(feedback_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; + } +} /* alpasscv_nn_fetch */ + + +void alpasscv_ns_fetch(register alpasscv_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 * delayptr_reg; + register sample_type * endptr_reg; + register sample_type feedback_scale_reg = susp->feedback->scale; + register sample_block_values_type feedback_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpasscv_ns_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +register sample_type y, z, fb; + y = *delayptr_reg; + *delayptr_reg++ = z = (sample_type) ((fb = (feedback_scale_reg * *feedback_ptr_reg++)) * y + *input_ptr_reg++); + *out_ptr_reg++ = (sample_type) (y - fb * z); + if (delayptr_reg >= endptr_reg) delayptr_reg = susp->delaybuf;; + } while (--n); /* inner loop */ + + susp->delayptr = delayptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(feedback_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; + } +} /* alpasscv_ns_fetch */ + + +void alpasscv_toss_fetch(susp, snd_list) + register alpasscv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* fetch samples from feedback up to final_time for this block of zeros */ + while ((round((final_time - susp->feedback->t0) * susp->feedback->sr)) >= + susp->feedback->current) + susp_get_samples(feedback, feedback_ptr, feedback_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + n = round((final_time - susp->feedback->t0) * susp->feedback->sr - + (susp->feedback->current - susp->feedback_cnt)); + susp->feedback_ptr += n; + susp_took(feedback_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void alpasscv_mark(alpasscv_susp_type susp) +{ + sound_xlmark(susp->input); + sound_xlmark(susp->feedback); +} + + +void alpasscv_free(alpasscv_susp_type susp) +{ +free(susp->delaybuf); sound_unref(susp->input); + sound_unref(susp->feedback); + ffree_generic(susp, sizeof(alpasscv_susp_node), "alpasscv_free"); +} + + +void alpasscv_print_tree(alpasscv_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); + + indent(n); + stdputstr("feedback:"); + sound_print_tree_1(susp->feedback, n); +} + + +sound_type snd_make_alpasscv(sound_type input, time_type delay, sound_type feedback) +{ + register alpasscv_susp_type susp; + rate_type sr = max(input->sr, feedback->sr); + time_type t0 = max(input->t0, feedback->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, alpasscv_susp_node, "snd_make_alpasscv"); + susp->delaylen = max(1, round(input->sr * delay)); + susp->delaybuf = (sample_type *) calloc (susp->delaylen, sizeof(sample_type)); + susp->delayptr = susp->delaybuf; + susp->endptr = susp->delaybuf + susp->delaylen; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(input, sr); + interp_desc = (interp_desc << 2) + interp_style(feedback, sr); + switch (interp_desc) { + case INTERP_nn: susp->susp.fetch = alpasscv_nn_fetch; break; + case INTERP_ns: susp->susp.fetch = alpasscv_ns_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + if (t0 < feedback->t0) sound_prepend_zeros(feedback, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->t0, min(feedback->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 = alpasscv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = alpasscv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = alpasscv_mark; + susp->susp.print_tree = alpasscv_print_tree; + susp->susp.name = "alpasscv"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + susp->feedback = feedback; + susp->feedback_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_alpasscv(sound_type input, time_type delay, sound_type feedback) +{ + sound_type input_copy = sound_copy(input); + sound_type feedback_copy = sound_copy(feedback); + return snd_make_alpasscv(input_copy, delay, feedback_copy); +} diff --git a/tran/alpasscv.h b/tran/alpasscv.h new file mode 100644 index 0000000..5d2ec0a --- /dev/null +++ b/tran/alpasscv.h @@ -0,0 +1,3 @@ +sound_type snd_make_alpasscv(sound_type input, time_type delay, sound_type feedback); +sound_type snd_alpasscv(sound_type input, time_type delay, sound_type feedback); + /* LISP: (snd-alpasscv SOUND ANYNUM SOUND) */ diff --git a/tran/alpassvc.alg b/tran/alpassvc.alg new file mode 100644 index 0000000..c3c13db --- /dev/null +++ b/tran/alpassvc.alg @@ -0,0 +1,59 @@ +(ALPASSVC-ALG +;; +;; delay is variable -- but we don't want to reallocate the delay buffer, so +;; use an additional parameter for the maximum allowable delay. The sound will +;; be written into the buffer every sample, but read using linear +;; interpolation. As in tapv, duplicate the sample at the first and last +;; locations in the buffer. +;; +(NAME "alpassvc") +(ARGUMENTS ("sound_type" "input") ("sound_type" "delaysnd") ("double" "feedback") + ("double" "maxdelay")) +(START (MAX input delaysnd)) +(STATE ("float" "delay_scale_factor" "(float) (input->sr * delaysnd->scale)") + ("double" "feedback" "feedback") + ("long" "buflen" "max(2, (long) (input->sr * maxdelay + 2.5))") + ("sample_type *" "delaybuf" + "(sample_type *) calloc (susp->buflen + 1, sizeof(sample_type))") + ("sample_type *" "delayptr" "susp->delaybuf") +;; since we allocate one extra sample, endptr points to the last sample + ("sample_type *" "endptr" "susp->delaybuf + susp->buflen")) +(CONSTANT "feedback" "delaylen" "endptr" "delay_scale_factor") +(NOT-REGISTER delaybuf) +(LINEAR input) +(TERMINATE (MIN input)) +(INNER-LOOP-LOCALS " register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr;\n") +(INNER-LOOP " + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + delaysamp = delaysnd * delay_scale_factor; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr + buflen - (delayi + 1); + if (yptr >= endptr) yptr -= buflen; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr++ = z = (sample_type) (feedback * y + input); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr > endptr) { + delayptr = susp->delaybuf; + *delayptr++ = *endptr; + } + output = (sample_type) (y - feedback * z);") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/alpassvc.c b/tran/alpassvc.c new file mode 100644 index 0000000..e5bdf4b --- /dev/null +++ b/tran/alpassvc.c @@ -0,0 +1,374 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "alpassvc.h" + +void alpassvc_free(); + + +typedef struct alpassvc_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + sound_type delaysnd; + long delaysnd_cnt; + sample_block_values_type delaysnd_ptr; + + float delay_scale_factor; + double feedback; + long buflen; + sample_type *delaybuf; + sample_type *delayptr; + sample_type *endptr; +} alpassvc_susp_node, *alpassvc_susp_type; + + +void alpassvc_nn_fetch(register alpassvc_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 float delay_scale_factor_reg; + register double feedback_reg; + register long buflen_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_block_values_type delaysnd_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpassvc_nn_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the delaysnd input sample block: */ + susp_check_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + togo = min(togo, susp->delaysnd_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; + delay_scale_factor_reg = susp->delay_scale_factor; + feedback_reg = susp->feedback; + buflen_reg = susp->buflen; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + delaysnd_ptr_reg = susp->delaysnd_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr; + + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + delaysamp = *delaysnd_ptr_reg++ * delay_scale_factor_reg; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr_reg + buflen_reg - (delayi + 1); + if (yptr >= endptr_reg) yptr -= buflen_reg; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr_reg++ = z = (sample_type) (feedback_reg * y + *input_ptr_reg++); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr_reg > endptr_reg) { + delayptr_reg = susp->delaybuf; + *delayptr_reg++ = *endptr_reg; + } + *out_ptr_reg++ = (sample_type) (y - feedback_reg * z);; + } while (--n); /* inner loop */ + + susp->buflen = buflen_reg; + susp->delayptr = delayptr_reg; + /* using delaysnd_ptr_reg is a bad idea on RS/6000: */ + susp->delaysnd_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(delaysnd_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; + } +} /* alpassvc_nn_fetch */ + + +void alpassvc_ns_fetch(register alpassvc_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 float delay_scale_factor_reg; + register double feedback_reg; + register long buflen_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_type delaysnd_scale_reg = susp->delaysnd->scale; + register sample_block_values_type delaysnd_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpassvc_ns_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the delaysnd input sample block: */ + susp_check_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + togo = min(togo, susp->delaysnd_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; + delay_scale_factor_reg = susp->delay_scale_factor; + feedback_reg = susp->feedback; + buflen_reg = susp->buflen; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + delaysnd_ptr_reg = susp->delaysnd_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr; + + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + delaysamp = (delaysnd_scale_reg * *delaysnd_ptr_reg++) * delay_scale_factor_reg; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr_reg + buflen_reg - (delayi + 1); + if (yptr >= endptr_reg) yptr -= buflen_reg; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr_reg++ = z = (sample_type) (feedback_reg * y + *input_ptr_reg++); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr_reg > endptr_reg) { + delayptr_reg = susp->delaybuf; + *delayptr_reg++ = *endptr_reg; + } + *out_ptr_reg++ = (sample_type) (y - feedback_reg * z);; + } while (--n); /* inner loop */ + + susp->buflen = buflen_reg; + susp->delayptr = delayptr_reg; + /* using delaysnd_ptr_reg is a bad idea on RS/6000: */ + susp->delaysnd_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(delaysnd_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; + } +} /* alpassvc_ns_fetch */ + + +void alpassvc_toss_fetch(susp, snd_list) + register alpassvc_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* fetch samples from delaysnd up to final_time for this block of zeros */ + while ((round((final_time - susp->delaysnd->t0) * susp->delaysnd->sr)) >= + susp->delaysnd->current) + susp_get_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + n = round((final_time - susp->delaysnd->t0) * susp->delaysnd->sr - + (susp->delaysnd->current - susp->delaysnd_cnt)); + susp->delaysnd_ptr += n; + susp_took(delaysnd_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void alpassvc_mark(alpassvc_susp_type susp) +{ + sound_xlmark(susp->input); + sound_xlmark(susp->delaysnd); +} + + +void alpassvc_free(alpassvc_susp_type susp) +{ +free(susp->delaybuf); sound_unref(susp->input); + sound_unref(susp->delaysnd); + ffree_generic(susp, sizeof(alpassvc_susp_node), "alpassvc_free"); +} + + +void alpassvc_print_tree(alpassvc_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); + + indent(n); + stdputstr("delaysnd:"); + sound_print_tree_1(susp->delaysnd, n); +} + + +sound_type snd_make_alpassvc(sound_type input, sound_type delaysnd, double feedback, double maxdelay) +{ + register alpassvc_susp_type susp; + rate_type sr = max(input->sr, delaysnd->sr); + time_type t0 = max(input->t0, delaysnd->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, alpassvc_susp_node, "snd_make_alpassvc"); + susp->delay_scale_factor = (float) (input->sr * delaysnd->scale); + susp->feedback = feedback; + susp->buflen = max(2, (long) (input->sr * maxdelay + 2.5)); + susp->delaybuf = (sample_type *) calloc (susp->buflen + 1, sizeof(sample_type)); + susp->delayptr = susp->delaybuf; + susp->endptr = susp->delaybuf + susp->buflen; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(input, sr); + interp_desc = (interp_desc << 2) + interp_style(delaysnd, sr); + switch (interp_desc) { + case INTERP_nn: susp->susp.fetch = alpassvc_nn_fetch; break; + case INTERP_ns: susp->susp.fetch = alpassvc_ns_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + if (t0 < delaysnd->t0) sound_prepend_zeros(delaysnd, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->t0, min(delaysnd->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 = alpassvc_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = alpassvc_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = alpassvc_mark; + susp->susp.print_tree = alpassvc_print_tree; + susp->susp.name = "alpassvc"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + susp->delaysnd = delaysnd; + susp->delaysnd_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_alpassvc(sound_type input, sound_type delaysnd, double feedback, double maxdelay) +{ + sound_type input_copy = sound_copy(input); + sound_type delaysnd_copy = sound_copy(delaysnd); + return snd_make_alpassvc(input_copy, delaysnd_copy, feedback, maxdelay); +} diff --git a/tran/alpassvc.h b/tran/alpassvc.h new file mode 100644 index 0000000..127f299 --- /dev/null +++ b/tran/alpassvc.h @@ -0,0 +1,3 @@ +sound_type snd_make_alpassvc(sound_type input, sound_type delaysnd, double feedback, double maxdelay); +sound_type snd_alpassvc(sound_type input, sound_type delaysnd, double feedback, double maxdelay); + /* LISP: (snd-alpassvc SOUND SOUND ANYNUM ANYNUM) */ diff --git a/tran/alpassvv.alg b/tran/alpassvv.alg new file mode 100644 index 0000000..cb4416c --- /dev/null +++ b/tran/alpassvv.alg @@ -0,0 +1,59 @@ +(ALPASSVC-ALG +;; +;; delay is variable -- but we don't want to reallocate the delay buffer, so +;; use an additional parameter for the maximum allowable delay. The sound will +;; be written into the buffer every sample, but read using linear +;; interpolation. As in tapv, duplicate the sample at the first and last +;; locations in the buffer. +;; +(NAME "alpassvv") +(ARGUMENTS ("sound_type" "input") ("sound_type" "delaysnd") ("sound_type" "feedback") + ("double" "maxdelay")) +(START (MAX input delaysnd)) +(STATE ("float" "delay_scale_factor" "(float) (input->sr * delaysnd->scale)") + ("long" "buflen" "max(2, (long) (input->sr * maxdelay + 2.5))") + ("sample_type *" "delaybuf" + "(sample_type *) calloc (susp->buflen + 1, sizeof(sample_type))") + ("sample_type *" "delayptr" "susp->delaybuf") +;; since we allocate one extra sample, endptr points to the last sample + ("sample_type *" "endptr" "susp->delaybuf + susp->buflen")) +(CONSTANT "delaylen" "endptr" "delay_scale_factor") +(NOT-REGISTER delaybuf) +(LINEAR input) +(TERMINATE (MIN input)) +(INNER-LOOP-LOCALS " register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr;\n") +(INNER-LOOP " + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + register sample_type fb = feedback; + delaysamp = delaysnd * delay_scale_factor; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr + buflen - (delayi + 1); + if (yptr >= endptr) yptr -= buflen; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr++ = z = (sample_type) (fb * y + input); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr > endptr) { + delayptr = susp->delaybuf; + *delayptr++ = *endptr; + } + output = (sample_type) (y - fb * z);") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/alpassvv.c b/tran/alpassvv.c new file mode 100644 index 0000000..308e6de --- /dev/null +++ b/tran/alpassvv.c @@ -0,0 +1,645 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "alpassvv.h" + +void alpassvv_free(); + + +typedef struct alpassvv_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + sound_type delaysnd; + long delaysnd_cnt; + sample_block_values_type delaysnd_ptr; + sound_type feedback; + long feedback_cnt; + sample_block_values_type feedback_ptr; + + float delay_scale_factor; + long buflen; + sample_type *delaybuf; + sample_type *delayptr; + sample_type *endptr; +} alpassvv_susp_node, *alpassvv_susp_type; + + +void alpassvv_nnn_fetch(register alpassvv_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 float delay_scale_factor_reg; + register long buflen_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_block_values_type feedback_ptr_reg; + register sample_block_values_type delaysnd_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpassvv_nnn_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the delaysnd input sample block: */ + susp_check_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + togo = min(togo, susp->delaysnd_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delay_scale_factor_reg = susp->delay_scale_factor; + buflen_reg = susp->buflen; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + delaysnd_ptr_reg = susp->delaysnd_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr; + + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + register sample_type fb = *feedback_ptr_reg++; + delaysamp = *delaysnd_ptr_reg++ * delay_scale_factor_reg; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr_reg + buflen_reg - (delayi + 1); + if (yptr >= endptr_reg) yptr -= buflen_reg; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr_reg++ = z = (sample_type) (fb * y + *input_ptr_reg++); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr_reg > endptr_reg) { + delayptr_reg = susp->delaybuf; + *delayptr_reg++ = *endptr_reg; + } + *out_ptr_reg++ = (sample_type) (y - fb * z);; + } while (--n); /* inner loop */ + + susp->buflen = buflen_reg; + susp->delayptr = delayptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using delaysnd_ptr_reg is a bad idea on RS/6000: */ + susp->delaysnd_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(delaysnd_cnt, togo); + susp_took(feedback_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; + } +} /* alpassvv_nnn_fetch */ + + +void alpassvv_nns_fetch(register alpassvv_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 float delay_scale_factor_reg; + register long buflen_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_type feedback_scale_reg = susp->feedback->scale; + register sample_block_values_type feedback_ptr_reg; + register sample_block_values_type delaysnd_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpassvv_nns_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the delaysnd input sample block: */ + susp_check_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + togo = min(togo, susp->delaysnd_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delay_scale_factor_reg = susp->delay_scale_factor; + buflen_reg = susp->buflen; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + delaysnd_ptr_reg = susp->delaysnd_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr; + + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + register sample_type fb = (feedback_scale_reg * *feedback_ptr_reg++); + delaysamp = *delaysnd_ptr_reg++ * delay_scale_factor_reg; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr_reg + buflen_reg - (delayi + 1); + if (yptr >= endptr_reg) yptr -= buflen_reg; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr_reg++ = z = (sample_type) (fb * y + *input_ptr_reg++); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr_reg > endptr_reg) { + delayptr_reg = susp->delaybuf; + *delayptr_reg++ = *endptr_reg; + } + *out_ptr_reg++ = (sample_type) (y - fb * z);; + } while (--n); /* inner loop */ + + susp->buflen = buflen_reg; + susp->delayptr = delayptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using delaysnd_ptr_reg is a bad idea on RS/6000: */ + susp->delaysnd_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(delaysnd_cnt, togo); + susp_took(feedback_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; + } +} /* alpassvv_nns_fetch */ + + +void alpassvv_nsn_fetch(register alpassvv_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 float delay_scale_factor_reg; + register long buflen_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_block_values_type feedback_ptr_reg; + register sample_type delaysnd_scale_reg = susp->delaysnd->scale; + register sample_block_values_type delaysnd_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpassvv_nsn_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the delaysnd input sample block: */ + susp_check_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + togo = min(togo, susp->delaysnd_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delay_scale_factor_reg = susp->delay_scale_factor; + buflen_reg = susp->buflen; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + delaysnd_ptr_reg = susp->delaysnd_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr; + + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + register sample_type fb = *feedback_ptr_reg++; + delaysamp = (delaysnd_scale_reg * *delaysnd_ptr_reg++) * delay_scale_factor_reg; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr_reg + buflen_reg - (delayi + 1); + if (yptr >= endptr_reg) yptr -= buflen_reg; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr_reg++ = z = (sample_type) (fb * y + *input_ptr_reg++); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr_reg > endptr_reg) { + delayptr_reg = susp->delaybuf; + *delayptr_reg++ = *endptr_reg; + } + *out_ptr_reg++ = (sample_type) (y - fb * z);; + } while (--n); /* inner loop */ + + susp->buflen = buflen_reg; + susp->delayptr = delayptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using delaysnd_ptr_reg is a bad idea on RS/6000: */ + susp->delaysnd_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(delaysnd_cnt, togo); + susp_took(feedback_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; + } +} /* alpassvv_nsn_fetch */ + + +void alpassvv_nss_fetch(register alpassvv_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 float delay_scale_factor_reg; + register long buflen_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_type feedback_scale_reg = susp->feedback->scale; + register sample_block_values_type feedback_ptr_reg; + register sample_type delaysnd_scale_reg = susp->delaysnd->scale; + register sample_block_values_type delaysnd_ptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "alpassvv_nss_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 input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the delaysnd input sample block: */ + susp_check_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + togo = min(togo, susp->delaysnd_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delay_scale_factor_reg = susp->delay_scale_factor; + buflen_reg = susp->buflen; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + delaysnd_ptr_reg = susp->delaysnd_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register sample_type y, z, delaysamp; + register int delayi; + register sample_type *yptr; + + /* compute where to read y, we want y to be delay_snd samples + * after delay_ptr, where we write the new sample. First, + * conver from seconds to samples. Note: don't use actual sound_type + * names in comments! The translator isn't smart enough. + */ + register sample_type fb = (feedback_scale_reg * *feedback_ptr_reg++); + delaysamp = (delaysnd_scale_reg * *delaysnd_ptr_reg++) * delay_scale_factor_reg; + delayi = (int) delaysamp; /* get integer part */ + delaysamp = delaysamp - delayi; /* get phase */ + yptr = delayptr_reg + buflen_reg - (delayi + 1); + if (yptr >= endptr_reg) yptr -= buflen_reg; + /* now get y, the out-put of the delay, using interpolation */ + /* note that as phase increases, we use more of yptr[0] because + positive phase means longer buffer means read earlier sample */ + y = (float) ((yptr[0] * delaysamp) + (yptr[1] * (1.0 - delaysamp))); + /* WARNING: no check to keep delaysamp in range, so do this in LISP */ + + *delayptr_reg++ = z = (sample_type) (fb * y + *input_ptr_reg++); + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + if (delayptr_reg > endptr_reg) { + delayptr_reg = susp->delaybuf; + *delayptr_reg++ = *endptr_reg; + } + *out_ptr_reg++ = (sample_type) (y - fb * z);; + } while (--n); /* inner loop */ + + susp->buflen = buflen_reg; + susp->delayptr = delayptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using delaysnd_ptr_reg is a bad idea on RS/6000: */ + susp->delaysnd_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(delaysnd_cnt, togo); + susp_took(feedback_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; + } +} /* alpassvv_nss_fetch */ + + +void alpassvv_toss_fetch(susp, snd_list) + register alpassvv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* fetch samples from delaysnd up to final_time for this block of zeros */ + while ((round((final_time - susp->delaysnd->t0) * susp->delaysnd->sr)) >= + susp->delaysnd->current) + susp_get_samples(delaysnd, delaysnd_ptr, delaysnd_cnt); + /* fetch samples from feedback up to final_time for this block of zeros */ + while ((round((final_time - susp->feedback->t0) * susp->feedback->sr)) >= + susp->feedback->current) + susp_get_samples(feedback, feedback_ptr, feedback_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + n = round((final_time - susp->delaysnd->t0) * susp->delaysnd->sr - + (susp->delaysnd->current - susp->delaysnd_cnt)); + susp->delaysnd_ptr += n; + susp_took(delaysnd_cnt, n); + n = round((final_time - susp->feedback->t0) * susp->feedback->sr - + (susp->feedback->current - susp->feedback_cnt)); + susp->feedback_ptr += n; + susp_took(feedback_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void alpassvv_mark(alpassvv_susp_type susp) +{ + sound_xlmark(susp->input); + sound_xlmark(susp->delaysnd); + sound_xlmark(susp->feedback); +} + + +void alpassvv_free(alpassvv_susp_type susp) +{ +free(susp->delaybuf); sound_unref(susp->input); + sound_unref(susp->delaysnd); + sound_unref(susp->feedback); + ffree_generic(susp, sizeof(alpassvv_susp_node), "alpassvv_free"); +} + + +void alpassvv_print_tree(alpassvv_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); + + indent(n); + stdputstr("delaysnd:"); + sound_print_tree_1(susp->delaysnd, n); + + indent(n); + stdputstr("feedback:"); + sound_print_tree_1(susp->feedback, n); +} + + +sound_type snd_make_alpassvv(sound_type input, sound_type delaysnd, sound_type feedback, double maxdelay) +{ + register alpassvv_susp_type susp; + rate_type sr = max(max(input->sr, delaysnd->sr), feedback->sr); + time_type t0 = max(input->t0, delaysnd->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, alpassvv_susp_node, "snd_make_alpassvv"); + susp->delay_scale_factor = (float) (input->sr * delaysnd->scale); + susp->buflen = max(2, (long) (input->sr * maxdelay + 2.5)); + susp->delaybuf = (sample_type *) calloc (susp->buflen + 1, sizeof(sample_type)); + susp->delayptr = susp->delaybuf; + susp->endptr = susp->delaybuf + susp->buflen; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(input, sr); + interp_desc = (interp_desc << 2) + interp_style(delaysnd, sr); + interp_desc = (interp_desc << 2) + interp_style(feedback, sr); + switch (interp_desc) { + case INTERP_nnn: susp->susp.fetch = alpassvv_nnn_fetch; break; + case INTERP_nns: susp->susp.fetch = alpassvv_nns_fetch; break; + case INTERP_nsn: susp->susp.fetch = alpassvv_nsn_fetch; break; + case INTERP_nss: susp->susp.fetch = alpassvv_nss_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + if (t0 < delaysnd->t0) sound_prepend_zeros(delaysnd, t0); + if (t0 < feedback->t0) sound_prepend_zeros(feedback, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->t0, min(delaysnd->t0, min(feedback->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 = alpassvv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = alpassvv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = alpassvv_mark; + susp->susp.print_tree = alpassvv_print_tree; + susp->susp.name = "alpassvv"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + susp->delaysnd = delaysnd; + susp->delaysnd_cnt = 0; + susp->feedback = feedback; + susp->feedback_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_alpassvv(sound_type input, sound_type delaysnd, sound_type feedback, double maxdelay) +{ + sound_type input_copy = sound_copy(input); + sound_type delaysnd_copy = sound_copy(delaysnd); + sound_type feedback_copy = sound_copy(feedback); + return snd_make_alpassvv(input_copy, delaysnd_copy, feedback_copy, maxdelay); +} diff --git a/tran/alpassvv.h b/tran/alpassvv.h new file mode 100644 index 0000000..efbc345 --- /dev/null +++ b/tran/alpassvv.h @@ -0,0 +1,3 @@ +sound_type snd_make_alpassvv(sound_type input, sound_type delaysnd, sound_type feedback, double maxdelay); +sound_type snd_alpassvv(sound_type input, sound_type delaysnd, sound_type feedback, double maxdelay); + /* LISP: (snd-alpassvv SOUND SOUND SOUND ANYNUM) */ diff --git a/tran/amosc.alg b/tran/amosc.alg new file mode 100644 index 0000000..0103202 --- /dev/null +++ b/tran/amosc.alg @@ -0,0 +1,33 @@ +(AMOSC-ALG +(NAME "amosc") +(ARGUMENTS ("sound_type" "input") ("double" "step") ("rate_type" "sr") + ("double" "hz") ("time_type" "t0") ("sound_type" "amod") + ("double" "phase")) +(TABLE "input") +(NOT-IN-INNER-LOOP "input") +(START (MIN input)) +(STATE + ("double" "ph_incr" "0") + ("table_type" "the_table" "sound_to_table(input)") + ("sample_type *" "table_ptr" "susp->the_table->samples") + ("double" "table_len" "susp->the_table->length") + ("double" "phase" "compute_phase(phase, step, (long) susp->table_len, + input->sr, sr, hz, &susp->ph_incr)") ) +(ALWAYS-SCALE amod) +(TERMINATE (MIN amod)) +(LOGICAL-STOP (MIN amod)) +(INNER-LOOP " + long table_index = (long) phase; + double x1 = (double) (table_ptr[table_index]); + output = (sample_type) (x1 + (phase - table_index) * + (table_ptr[table_index + 1] - x1)) * amod; + phase += ph_incr; + while (phase > table_len) phase -= table_len; +") +(CONSTANT "ph_incr" "table_len" "table_ptr" "the_table") + +(SAMPLE-RATE "sr") +(FINALIZATION " table_unref(susp->the_table); +") +) + diff --git a/tran/amosc.c b/tran/amosc.c new file mode 100644 index 0000000..16e45b4 --- /dev/null +++ b/tran/amosc.c @@ -0,0 +1,227 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "amosc.h" + +void amosc_free(); + + +typedef struct amosc_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type amod; + long amod_cnt; + sample_block_values_type amod_ptr; + + double ph_incr; + table_type the_table; + sample_type *table_ptr; + double table_len; + double phase; +} amosc_susp_node, *amosc_susp_type; + + +void amosc_s_fetch(register amosc_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 double ph_incr_reg; + register sample_type * table_ptr_reg; + register double table_len_reg; + register double phase_reg; + register sample_type amod_scale_reg = susp->amod->scale; + register sample_block_values_type amod_ptr_reg; + falloc_sample_block(out, "amosc_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 amod input sample block: */ + susp_check_term_log_samples(amod, amod_ptr, amod_cnt); + togo = min(togo, susp->amod_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; + ph_incr_reg = susp->ph_incr; + table_ptr_reg = susp->table_ptr; + table_len_reg = susp->table_len; + phase_reg = susp->phase; + amod_ptr_reg = susp->amod_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + long table_index = (long) phase_reg; + double x1 = (double) (table_ptr_reg[table_index]); + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)) * (amod_scale_reg * *amod_ptr_reg++); + phase_reg += ph_incr_reg; + while (phase_reg > table_len_reg) phase_reg -= table_len_reg; +; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + /* using amod_ptr_reg is a bad idea on RS/6000: */ + susp->amod_ptr += togo; + out_ptr += togo; + susp_took(amod_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; + } +} /* amosc_s_fetch */ + + +void amosc_toss_fetch(susp, snd_list) + register amosc_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from amod up to final_time for this block of zeros */ + while ((round((final_time - susp->amod->t0) * susp->amod->sr)) >= + susp->amod->current) + susp_get_samples(amod, amod_ptr, amod_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->amod->t0) * susp->amod->sr - + (susp->amod->current - susp->amod_cnt)); + susp->amod_ptr += n; + susp_took(amod_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void amosc_mark(amosc_susp_type susp) +{ + sound_xlmark(susp->amod); +} + + +void amosc_free(amosc_susp_type susp) +{ + table_unref(susp->the_table); + sound_unref(susp->amod); + ffree_generic(susp, sizeof(amosc_susp_node), "amosc_free"); +} + + +void amosc_print_tree(amosc_susp_type susp, int n) +{ + indent(n); + stdputstr("amod:"); + sound_print_tree_1(susp->amod, n); +} + + +sound_type snd_make_amosc(sound_type input, double step, rate_type sr, double hz, time_type t0, sound_type amod, double phase) +{ + register amosc_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, amosc_susp_node, "snd_make_amosc"); + susp->ph_incr = 0; + susp->the_table = sound_to_table(input); + susp->table_ptr = susp->the_table->samples; + susp->table_len = susp->the_table->length; + susp->phase = compute_phase(phase, step, (long) susp->table_len, + input->sr, sr, hz, &susp->ph_incr); + susp->susp.fetch = amosc_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < amod->t0) sound_prepend_zeros(amod, t0); + /* minimum start time over all inputs: */ + t0_min = min(amod->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 = amosc_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = amosc_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = amosc_mark; + susp->susp.print_tree = amosc_print_tree; + susp->susp.name = "amosc"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(amod); + susp->susp.current = 0; + susp->amod = amod; + susp->amod_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_amosc(sound_type input, double step, rate_type sr, double hz, time_type t0, sound_type amod, double phase) +{ + sound_type amod_copy = sound_copy(amod); + return snd_make_amosc(input, step, sr, hz, t0, amod_copy, phase); +} diff --git a/tran/amosc.h b/tran/amosc.h new file mode 100644 index 0000000..cc798f9 --- /dev/null +++ b/tran/amosc.h @@ -0,0 +1,3 @@ +sound_type snd_make_amosc(sound_type input, double step, rate_type sr, double hz, time_type t0, sound_type amod, double phase); +sound_type snd_amosc(sound_type input, double step, rate_type sr, double hz, time_type t0, sound_type amod, double phase); + /* LISP: (snd-amosc SOUND ANYNUM ANYNUM ANYNUM ANYNUM SOUND ANYNUM) */ diff --git a/tran/areson.alg b/tran/areson.alg new file mode 100644 index 0000000..a26287e --- /dev/null +++ b/tran/areson.alg @@ -0,0 +1,24 @@ +(ARESON-ALG +(NAME "areson") +(ARGUMENTS ("sound_type" "input") ("double" "hz") ("double" "bw") + ("int" "normalization")) +(START (MIN input)) +(TERMINATE (MIN input)) +(LOGICAL-STOP (MIN input)) +(LINEAR input) +(STATE ("double" "c3" "exp(bw * -PI2 / input->sr)") + ("double" "c3p1" "susp->c3 + 1.0" TEMP) + ("double" "c3t4" "susp->c3 * 4.0" TEMP) + ("double" "omc3" "1.0 - susp->c3" TEMP) + ("double" "c2" "c3t4 * cos(hz * PI2 / input->sr) / c3p1") + ("double" "c1" "(normalization == 0 ? 0.0 : + (normalization == 1 ? 1.0 - omc3 * sqrt(1.0 - susp->c2 * susp->c2 / c3t4) : + 1.0 - sqrt(c3p1 * c3p1 - susp->c2 * susp->c2) * omc3 / c3p1))") + ("double" "y1" "0.0") + ("double" "y2" "0.0")) +(CONSTANT "c1" "c2" "c3") +(INNER-LOOP-LOCALS " register double y0, current;") +(INNER-LOOP "current = input; + output = (sample_type) (y0 = c1 * current + c2 * y1 - c3 * y2); + y2 = y1; y1 = y0 - current") +) diff --git a/tran/areson.c b/tran/areson.c new file mode 100644 index 0000000..6fb04e2 --- /dev/null +++ b/tran/areson.c @@ -0,0 +1,237 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "areson.h" + +void areson_free(); + + +typedef struct areson_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + double c3; + double c2; + double c1; + double y1; + double y2; +} areson_susp_node, *areson_susp_type; + + +void areson_n_fetch(register areson_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 double c3_reg; + register double c2_reg; + register double c1_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "areson_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + c3_reg = susp->c3; + c2_reg = susp->c2; + c1_reg = susp->c1; + y1_reg = susp->y1; + y2_reg = susp->y2; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current;current = *input_ptr_reg++; + *out_ptr_reg++ = (sample_type) (y0 = c1_reg * current + c2_reg * y1_reg - c3_reg * y2_reg); + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* areson_n_fetch */ + + +void areson_toss_fetch(susp, snd_list) + register areson_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void areson_mark(areson_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void areson_free(areson_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(areson_susp_node), "areson_free"); +} + + +void areson_print_tree(areson_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_areson(sound_type input, double hz, double bw, int normalization) +{ + register areson_susp_type susp; + double c3p1; + double c3t4; + double omc3; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, areson_susp_node, "snd_make_areson"); + susp->c3 = exp(bw * -PI2 / input->sr); + c3p1 = susp->c3 + 1.0; + c3t4 = susp->c3 * 4.0; + omc3 = 1.0 - susp->c3; + susp->c2 = c3t4 * cos(hz * PI2 / input->sr) / c3p1; + susp->c1 = (normalization == 0 ? 0.0 : + (normalization == 1 ? 1.0 - omc3 * sqrt(1.0 - susp->c2 * susp->c2 / c3t4) : + 1.0 - sqrt(c3p1 * c3p1 - susp->c2 * susp->c2) * omc3 / c3p1)); + susp->y1 = 0.0; + susp->y2 = 0.0; + susp->susp.fetch = areson_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = areson_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = areson_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = areson_mark; + susp->susp.print_tree = areson_print_tree; + susp->susp.name = "areson"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_areson(sound_type input, double hz, double bw, int normalization) +{ + sound_type input_copy = sound_copy(input); + return snd_make_areson(input_copy, hz, bw, normalization); +} diff --git a/tran/areson.h b/tran/areson.h new file mode 100644 index 0000000..fa7c94f --- /dev/null +++ b/tran/areson.h @@ -0,0 +1,3 @@ +sound_type snd_make_areson(sound_type input, double hz, double bw, int normalization); +sound_type snd_areson(sound_type input, double hz, double bw, int normalization); + /* LISP: (snd-areson SOUND ANYNUM ANYNUM FIXNUM) */ diff --git a/tran/aresoncv.alg b/tran/aresoncv.alg new file mode 100644 index 0000000..f439867 --- /dev/null +++ b/tran/aresoncv.alg @@ -0,0 +1,36 @@ +(ARESONCV-ALG +(NAME "aresoncv") +(ARGUMENTS ("sound_type" "s1") ("double" "hz") ("sound_type" "bw") + ("int" "normalization")) +(INLINE-INTERPOLATION T) +(LINEAR s1) +(ALWAYS-SCALE bw) +(START (MAX s1 bw)) +(TERMINATE (MIN s1 bw)) +(LOGICAL-STOP (MIN s1)) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION bw) +(STATE ("double" "c3co" "0.0") + ("double" "coshz" "cos(hz * PI2 / s1->sr)") + ("double" "c2" "0.0") + ("double" "c1" "0.0") + ("int" "normalization" "normalization") + ("double" "y1" "0.0") + ("double" "y2" "0.0; + bw->scale = (float) (bw->scale * (-PI2 / s1->sr))")) +(DEPENDS ("c3co" "hz" "exp(bw)") + ("c3p1" "hz" "c3co + 1.0" TEMP "double") + ("c3t4" "hz" "c3co * 4.0" TEMP "double") + ("omc3" "hz" "1.0 - c3co" TEMP "double") + ("c2" "hz" "c3t4 * coshz / c3p1") + ("c1" "hz" "(normalization == 0 ? 0.0 : + (normalization == 1 ? 1.0 - omc3 * sqrt(1.0 - c2 * c2 / c3t4) : + 1.0 - sqrt(c3p1 * c3p1 - c2 * c2) * omc3 / c3p1))")) +(CONSTANT "c1" "c2" "c3co" "coshz" "normalization") +(FORCE-INTO-REGISTER normalization coshz scale1) +(INNER-LOOP-LOCALS " register double y0, current;") +(INNER-LOOP " + current = s1; + output = (float) (y0 = c1 * current + c2 * y1 - c3co * y2); + y2 = y1; y1 = y0 - current") +) diff --git a/tran/aresoncv.c b/tran/aresoncv.c new file mode 100644 index 0000000..d29e599 --- /dev/null +++ b/tran/aresoncv.c @@ -0,0 +1,554 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "aresoncv.h" + +void aresoncv_free(); + + +typedef struct aresoncv_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type bw; + long bw_cnt; + sample_block_values_type bw_ptr; + + /* support for interpolation of bw */ + sample_type bw_x1_sample; + double bw_pHaSe; + double bw_pHaSe_iNcR; + + /* support for ramp between samples of bw */ + double output_per_bw; + long bw_n; + + double c3co; + double coshz; + double c2; + double c1; + int normalization; + double y1; + double y2; +} aresoncv_susp_node, *aresoncv_susp_type; + + +void aresoncv_ns_fetch(register aresoncv_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 double c3co_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresoncv_ns_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + c3co_reg = susp->c3co; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; + current = *s1_ptr_reg++; + *out_ptr_reg++ = (float) (y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg); + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(bw_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; + } +} /* aresoncv_ns_fetch */ + + +void aresoncv_ni_fetch(register aresoncv_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 double c3co_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresoncv_ni_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_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + c3co_reg = susp->c3co; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + } + + current = *s1_ptr_reg++; + *out_ptr_reg++ = (float) (y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg); + y2_reg = y1_reg; y1_reg = y0 - current; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* aresoncv_ni_fetch */ + + +void aresoncv_nr_fetch(register aresoncv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresoncv_nr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + c3co_reg = susp->c3co; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; + current = *s1_ptr_reg++; + *out_ptr_reg++ = (float) (y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg); + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* aresoncv_nr_fetch */ + + +void aresoncv_toss_fetch(susp, snd_list) + register aresoncv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from bw up to final_time for this block of zeros */ + while ((round((final_time - susp->bw->t0) * susp->bw->sr)) >= + susp->bw->current) + susp_get_samples(bw, bw_ptr, bw_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->bw->t0) * susp->bw->sr - + (susp->bw->current - susp->bw_cnt)); + susp->bw_ptr += n; + susp_took(bw_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void aresoncv_mark(aresoncv_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->bw); +} + + +void aresoncv_free(aresoncv_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->bw); + ffree_generic(susp, sizeof(aresoncv_susp_node), "aresoncv_free"); +} + + +void aresoncv_print_tree(aresoncv_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("bw:"); + sound_print_tree_1(susp->bw, n); +} + + +sound_type snd_make_aresoncv(sound_type s1, double hz, sound_type bw, int normalization) +{ + register aresoncv_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, bw->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (S1) */ + scale_factor *= s1->scale; + s1->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (s1->sr < sr) { s1->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, aresoncv_susp_node, "snd_make_aresoncv"); + susp->c3co = 0.0; + susp->coshz = cos(hz * PI2 / s1->sr); + susp->c2 = 0.0; + susp->c1 = 0.0; + susp->normalization = normalization; + susp->y1 = 0.0; + susp->y2 = 0.0; + bw->scale = (float) (bw->scale * (-PI2 / s1->sr)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(bw, sr); + switch (interp_desc) { + case INTERP_nn: /* handled below */ + case INTERP_ns: susp->susp.fetch = aresoncv_ns_fetch; break; + case INTERP_ni: susp->susp.fetch = aresoncv_ni_fetch; break; + case INTERP_nr: susp->susp.fetch = aresoncv_nr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < bw->t0) sound_prepend_zeros(bw, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(bw->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 = aresoncv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = aresoncv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = aresoncv_mark; + susp->susp.print_tree = aresoncv_print_tree; + susp->susp.name = "aresoncv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->bw = bw; + susp->bw_cnt = 0; + susp->bw_pHaSe = 0.0; + susp->bw_pHaSe_iNcR = bw->sr / sr; + susp->bw_n = 0; + susp->output_per_bw = sr / bw->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_aresoncv(sound_type s1, double hz, sound_type bw, int normalization) +{ + sound_type s1_copy = sound_copy(s1); + sound_type bw_copy = sound_copy(bw); + return snd_make_aresoncv(s1_copy, hz, bw_copy, normalization); +} diff --git a/tran/aresoncv.h b/tran/aresoncv.h new file mode 100644 index 0000000..6cf9a0a --- /dev/null +++ b/tran/aresoncv.h @@ -0,0 +1,3 @@ +sound_type snd_make_aresoncv(sound_type s1, double hz, sound_type bw, int normalization); +sound_type snd_aresoncv(sound_type s1, double hz, sound_type bw, int normalization); + /* LISP: (snd-aresoncv SOUND ANYNUM SOUND FIXNUM) */ diff --git a/tran/aresonvc.alg b/tran/aresonvc.alg new file mode 100644 index 0000000..277ef8a --- /dev/null +++ b/tran/aresonvc.alg @@ -0,0 +1,34 @@ +(ARESONVC-ALG +(NAME "aresonvc") +(ARGUMENTS ("sound_type" "s1") ("sound_type" "hz") ("double" "bw") + ("int" "normalization")) +(LINEAR s1) +(INLINE-INTERPOLATION T) +(ALWAYS-SCALE hz) +(START (MAX s1 hz)) +(TERMINATE (MIN s1 hz)) +(LOGICAL-STOP (MIN s1)) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION hz) +(STATE ("double" "c3co" "exp(bw * -PI2 / s1->sr)") + ("double" "c3p1" "susp->c3co + 1.0") + ("double" "c3t4" "susp->c3co * 4.0") + ("double" "omc3" "1.0 - susp->c3co") + ("double" "c2" "0.0") + ("double" "c1" "0.0") + ("int" "normalization" "normalization") + ("double" "y1" "0.0") + ("double" "y2" "0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr))")) +(DEPENDS ("c2" "hz" "c3t4 * cos(hz) / c3p1") + ("c1" "hz" "(normalization == 0 ? 0.0 : + (normalization == 1 ? 1.0 - omc3 * sqrt(1.0 - c2 * c2 / c3t4) : + 1.0 - sqrt(c3p1 * c3p1 - c2 * c2) * omc3 / c3p1))")) +(CONSTANT "c1" "c2" "c3co" "c3p1" "c3t4" "omc3" "normalization") +(FORCE-INTO-REGISTER c3t4 c3p1 normalization omc3) +(INNER-LOOP-LOCALS " register double y0, current;") +(INNER-LOOP "current = s1; + y0 = c1 * current + c2 * y1 - c3co * y2; + output = (sample_type) y0; + y2 = y1; y1 = y0 - current") +) diff --git a/tran/aresonvc.c b/tran/aresonvc.c new file mode 100644 index 0000000..f0c47fc --- /dev/null +++ b/tran/aresonvc.c @@ -0,0 +1,586 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "aresonvc.h" + +void aresonvc_free(); + + +typedef struct aresonvc_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type hz; + long hz_cnt; + sample_block_values_type hz_ptr; + + /* support for interpolation of hz */ + sample_type hz_x1_sample; + double hz_pHaSe; + double hz_pHaSe_iNcR; + + /* support for ramp between samples of hz */ + double output_per_hz; + long hz_n; + + double c3co; + double c3p1; + double c3t4; + double omc3; + double c2; + double c1; + int normalization; + double y1; + double y2; +} aresonvc_susp_node, *aresonvc_susp_type; + + +void aresonvc_ns_fetch(register aresonvc_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 double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type hz_scale_reg = susp->hz->scale; + register sample_block_values_type hz_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvc_ns_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz input sample block: */ + susp_check_term_samples(hz, hz_ptr, hz_cnt); + togo = min(togo, susp->hz_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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz_ptr_reg = susp->hz_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; c2_reg = c3t4_reg * cos((hz_scale_reg * *hz_ptr_reg++)) / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using hz_ptr_reg is a bad idea on RS/6000: */ + susp->hz_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz_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; + } +} /* aresonvc_ns_fetch */ + + +void aresonvc_ni_fetch(register aresonvc_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 double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double hz_pHaSe_iNcR_rEg = susp->hz_pHaSe_iNcR; + register double hz_pHaSe_ReG; + register sample_type hz_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvc_ni_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_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->c2 = susp->c3t4 * cos(susp->hz_x1_sample) / susp->c3p1; + susp->c1 = (susp->normalization == 0 ? 0.0 : + (susp->normalization == 1 ? 1.0 - susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + 1.0 - sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)); + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz_pHaSe_ReG = susp->hz_pHaSe; + hz_x1_sample_reg = susp->hz_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; if (hz_pHaSe_ReG >= 1.0) { +/* fixup-depends hz */ + /* pick up next sample as hz_x1_sample: */ + susp->hz_ptr++; + susp_took(hz_cnt, 1); + hz_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz, hz_ptr, hz_cnt, hz_x1_sample_reg); + hz_x1_sample_reg = susp_current_sample(hz, hz_ptr); + c2_reg = susp->c2 = c3t4_reg * cos(hz_x1_sample_reg) / c3p1_reg; + c1_reg = susp->c1 = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + hz_pHaSe_ReG += hz_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->hz_pHaSe = hz_pHaSe_ReG; + susp->hz_x1_sample = hz_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* aresonvc_ni_fetch */ + + +void aresonvc_nr_fetch(register aresonvc_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvc_nr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz_pHaSe = 1.0; + } + + susp_check_term_samples(hz, hz_ptr, hz_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz_x1_sample when phase goes past 1.0; */ + /* use hz_n (computed below) to avoid roundoff errors: */ + if (susp->hz_n <= 0) { + susp_check_term_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->hz_pHaSe -= 1.0; + /* hz_n gets number of samples before phase exceeds 1.0: */ + susp->hz_n = (long) ((1.0 - susp->hz_pHaSe) * + susp->output_per_hz); + susp->c2 = susp->c3t4 * cos(susp->hz_x1_sample) / susp->c3p1; + susp->c1 = (susp->normalization == 0 ? 0.0 : + (susp->normalization == 1 ? 1.0 - susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + 1.0 - sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)); + } + togo = min(togo, susp->hz_n); + hz_val = susp->hz_x1_sample; + /* 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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current;current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz_pHaSe += togo * susp->hz_pHaSe_iNcR; + susp->hz_n -= 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; + } +} /* aresonvc_nr_fetch */ + + +void aresonvc_toss_fetch(susp, snd_list) + register aresonvc_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from hz up to final_time for this block of zeros */ + while ((round((final_time - susp->hz->t0) * susp->hz->sr)) >= + susp->hz->current) + susp_get_samples(hz, hz_ptr, hz_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->hz->t0) * susp->hz->sr - + (susp->hz->current - susp->hz_cnt)); + susp->hz_ptr += n; + susp_took(hz_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void aresonvc_mark(aresonvc_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->hz); +} + + +void aresonvc_free(aresonvc_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->hz); + ffree_generic(susp, sizeof(aresonvc_susp_node), "aresonvc_free"); +} + + +void aresonvc_print_tree(aresonvc_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("hz:"); + sound_print_tree_1(susp->hz, n); +} + + +sound_type snd_make_aresonvc(sound_type s1, sound_type hz, double bw, int normalization) +{ + register aresonvc_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, hz->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (S1) */ + scale_factor *= s1->scale; + s1->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (s1->sr < sr) { s1->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, aresonvc_susp_node, "snd_make_aresonvc"); + susp->c3co = exp(bw * -PI2 / s1->sr); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->c2 = 0.0; + susp->c1 = 0.0; + susp->normalization = normalization; + susp->y1 = 0.0; + susp->y2 = 0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(hz, sr); + switch (interp_desc) { + case INTERP_nn: /* handled below */ + case INTERP_ns: susp->susp.fetch = aresonvc_ns_fetch; break; + case INTERP_ni: susp->susp.fetch = aresonvc_ni_fetch; break; + case INTERP_nr: susp->susp.fetch = aresonvc_nr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < hz->t0) sound_prepend_zeros(hz, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(hz->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 = aresonvc_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = aresonvc_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = aresonvc_mark; + susp->susp.print_tree = aresonvc_print_tree; + susp->susp.name = "aresonvc"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->hz = hz; + susp->hz_cnt = 0; + susp->hz_pHaSe = 0.0; + susp->hz_pHaSe_iNcR = hz->sr / sr; + susp->hz_n = 0; + susp->output_per_hz = sr / hz->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_aresonvc(sound_type s1, sound_type hz, double bw, int normalization) +{ + sound_type s1_copy = sound_copy(s1); + sound_type hz_copy = sound_copy(hz); + return snd_make_aresonvc(s1_copy, hz_copy, bw, normalization); +} diff --git a/tran/aresonvc.h b/tran/aresonvc.h new file mode 100644 index 0000000..0783f66 --- /dev/null +++ b/tran/aresonvc.h @@ -0,0 +1,3 @@ +sound_type snd_make_aresonvc(sound_type s1, sound_type hz, double bw, int normalization); +sound_type snd_aresonvc(sound_type s1, sound_type hz, double bw, int normalization); + /* LISP: (snd-aresonvc SOUND SOUND ANYNUM FIXNUM) */ diff --git a/tran/aresonvv.alg b/tran/aresonvv.alg new file mode 100644 index 0000000..a56c2fd --- /dev/null +++ b/tran/aresonvv.alg @@ -0,0 +1,50 @@ +(ARESONVV-ALG +(NAME "aresonvv") +(ARGUMENTS ("sound_type" "s1") ("sound_type" "hz1") ("sound_type" "bw") + ("int" "normalization")) +(INLINE-INTERPOLATION T) +(ALWAYS-SCALE hz1 bw) +(START (MAX s1 hz1 bw)) +(TERMINATE (MIN s1 hz1 bw)) +(LOGICAL-STOP (MIN s1)) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION hz1 bw) +(LINEAR s1) +(STATE ("double" "scale1" "s1->scale") + ("double" "c3co" "0.0") + ("double" "c3p1" "0.0") + ("double" "c3t4" "0.0") + ("double" "omc3" "0.0") + ("double" "coshz" "0.0") + ("double" "c2" "0.0") + ("double" "c1" "0.0") + ("boolean" "recompute" "false") + ("int" "normalization" "normalization") + ("double" "y1" "0.0") + ("double" "y2" "0.0; + hz1->scale = (sample_type) (hz1->scale * (PI2 / s1->sr)); + bw->scale = (sample_type) (bw->scale * (-PI2 / s1->sr));")) +(DEPENDS ("coshz" "hz1" "cos(hz1)") + ("recompute" "hz1" "true") + ("c3co" "bw" "exp(bw)") + ("c3p1" "bw" "c3co + 1.0") + ("c3t4" "bw" "c3co * 4.0") + ("omc3" "bw" "1.0 - c3co") + ("recompute" "bw" "true")) +(JOINT-DEPENDENCY (("hz1" "bw") +"if (recompute) {" +" recompute = false;" +" c2 = c3t4 * coshz / c3p1;" +" c1 = (normalization == 0 ? 0.0 :" +" (normalization == 1 ? 1.0 - omc3 * sqrt(1.0 - c2 * c2 / c3t4) :" +" 1.0 - sqrt(c3p1 * c3p1 - c2 * c2) * omc3 / c3p1));" +"}")) +(CONSTANT "c1" "c2" "c3co" "coshz" "c3p1" "c3t4" "omc3" + "normalization" "scale1") +(FORCE-INTO-REGISTER recompute) ;c3t4 c3p1 normalization omc3 scale1 +(INNER-LOOP-LOCALS " register double y0, current;") +(INNER-LOOP "current = s1; + y0 = c1 * current + c2 * y1 - c3co * y2; + output = (sample_type) y0; + y2 = y1; y1 = y0 - current") +) diff --git a/tran/aresonvv.c b/tran/aresonvv.c new file mode 100644 index 0000000..b38d9d9 --- /dev/null +++ b/tran/aresonvv.c @@ -0,0 +1,1729 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "aresonvv.h" + +void aresonvv_free(); + + +typedef struct aresonvv_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type hz1; + long hz1_cnt; + sample_block_values_type hz1_ptr; + + /* support for interpolation of hz1 */ + sample_type hz1_x1_sample; + double hz1_pHaSe; + double hz1_pHaSe_iNcR; + + /* support for ramp between samples of hz1 */ + double output_per_hz1; + long hz1_n; + sound_type bw; + long bw_cnt; + sample_block_values_type bw_ptr; + + /* support for interpolation of bw */ + sample_type bw_x1_sample; + double bw_pHaSe; + double bw_pHaSe_iNcR; + + /* support for ramp between samples of bw */ + double output_per_bw; + long bw_n; + + double scale1; + double c3co; + double c3p1; + double c3t4; + double omc3; + double coshz; + double c2; + double c1; + boolean recompute; + int normalization; + double y1; + double y2; +} aresonvv_susp_node, *aresonvv_susp_type; + + +void aresonvv_nss_fetch(register aresonvv_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 double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nss_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_cnt, togo); + susp_took(bw_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; + } +} /* aresonvv_nss_fetch */ + + +void aresonvv_nsi_fetch(register aresonvv_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 double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nsi_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_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_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; + } +} /* aresonvv_nsi_fetch */ + + +void aresonvv_nsr_fetch(register aresonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nsr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* aresonvv_nsr_fetch */ + + +void aresonvv_nis_fetch(register aresonvv_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 double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nis_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(bw_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; + } +} /* aresonvv_nis_fetch */ + + +void aresonvv_nii_fetch(register aresonvv_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 double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nii_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* aresonvv_nii_fetch */ + + +void aresonvv_nir_fetch(register aresonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nir_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* aresonvv_nir_fetch */ + + +void aresonvv_nrs_fetch(register aresonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nrs_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= togo; + susp_took(bw_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; + } +} /* aresonvv_nrs_fetch */ + + +void aresonvv_nri_fetch(register aresonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nri_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* 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; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current; if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 0.0 : + (normalization_reg == 1 ? 1.0 - omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + 1.0 - sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)); + } +current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= 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; + } +} /* aresonvv_nri_fetch */ + + +void aresonvv_nrr_fetch(register aresonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "aresonvv_nrr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + if (susp->recompute) { + susp->recompute = false; + susp->c2 = susp->c3t4 * susp->coshz / susp->c3p1; + susp->c1 = (susp->normalization == 0 ? 0.0 : + (susp->normalization == 1 ? 1.0 - susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + 1.0 - sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)); + } + /* 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; + c3co_reg = susp->c3co; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + y1_reg = susp->y1; + y2_reg = susp->y2; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double y0, current;current = *s1_ptr_reg++; + y0 = c1_reg * current + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0 - current; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= togo; + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* aresonvv_nrr_fetch */ + + +void aresonvv_toss_fetch(susp, snd_list) + register aresonvv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from hz1 up to final_time for this block of zeros */ + while ((round((final_time - susp->hz1->t0) * susp->hz1->sr)) >= + susp->hz1->current) + susp_get_samples(hz1, hz1_ptr, hz1_cnt); + /* fetch samples from bw up to final_time for this block of zeros */ + while ((round((final_time - susp->bw->t0) * susp->bw->sr)) >= + susp->bw->current) + susp_get_samples(bw, bw_ptr, bw_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->hz1->t0) * susp->hz1->sr - + (susp->hz1->current - susp->hz1_cnt)); + susp->hz1_ptr += n; + susp_took(hz1_cnt, n); + n = round((final_time - susp->bw->t0) * susp->bw->sr - + (susp->bw->current - susp->bw_cnt)); + susp->bw_ptr += n; + susp_took(bw_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void aresonvv_mark(aresonvv_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->hz1); + sound_xlmark(susp->bw); +} + + +void aresonvv_free(aresonvv_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->hz1); + sound_unref(susp->bw); + ffree_generic(susp, sizeof(aresonvv_susp_node), "aresonvv_free"); +} + + +void aresonvv_print_tree(aresonvv_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("hz1:"); + sound_print_tree_1(susp->hz1, n); + + indent(n); + stdputstr("bw:"); + sound_print_tree_1(susp->bw, n); +} + + +sound_type snd_make_aresonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization) +{ + register aresonvv_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(max(s1->t0, hz1->t0), bw->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (S1) */ + scale_factor *= s1->scale; + s1->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (s1->sr < sr) { s1->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, aresonvv_susp_node, "snd_make_aresonvv"); + susp->scale1 = s1->scale; + susp->c3co = 0.0; + susp->c3p1 = 0.0; + susp->c3t4 = 0.0; + susp->omc3 = 0.0; + susp->coshz = 0.0; + susp->c2 = 0.0; + susp->c1 = 0.0; + susp->recompute = false; + susp->normalization = normalization; + susp->y1 = 0.0; + susp->y2 = 0.0; + hz1->scale = (sample_type) (hz1->scale * (PI2 / s1->sr)); + bw->scale = (sample_type) (bw->scale * (-PI2 / s1->sr));; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(hz1, sr); + interp_desc = (interp_desc << 2) + interp_style(bw, sr); + switch (interp_desc) { + case INTERP_nnn: /* handled below */ + case INTERP_nns: /* handled below */ + case INTERP_nsn: /* handled below */ + case INTERP_nss: susp->susp.fetch = aresonvv_nss_fetch; break; + case INTERP_nni: /* handled below */ + case INTERP_nsi: susp->susp.fetch = aresonvv_nsi_fetch; break; + case INTERP_nnr: /* handled below */ + case INTERP_nsr: susp->susp.fetch = aresonvv_nsr_fetch; break; + case INTERP_nin: /* handled below */ + case INTERP_nis: susp->susp.fetch = aresonvv_nis_fetch; break; + case INTERP_nii: susp->susp.fetch = aresonvv_nii_fetch; break; + case INTERP_nir: susp->susp.fetch = aresonvv_nir_fetch; break; + case INTERP_nrn: /* handled below */ + case INTERP_nrs: susp->susp.fetch = aresonvv_nrs_fetch; break; + case INTERP_nri: susp->susp.fetch = aresonvv_nri_fetch; break; + case INTERP_nrr: susp->susp.fetch = aresonvv_nrr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < hz1->t0) sound_prepend_zeros(hz1, t0); + if (t0 < bw->t0) sound_prepend_zeros(bw, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(hz1->t0, min(bw->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 = aresonvv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = aresonvv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = aresonvv_mark; + susp->susp.print_tree = aresonvv_print_tree; + susp->susp.name = "aresonvv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->hz1 = hz1; + susp->hz1_cnt = 0; + susp->hz1_pHaSe = 0.0; + susp->hz1_pHaSe_iNcR = hz1->sr / sr; + susp->hz1_n = 0; + susp->output_per_hz1 = sr / hz1->sr; + susp->bw = bw; + susp->bw_cnt = 0; + susp->bw_pHaSe = 0.0; + susp->bw_pHaSe_iNcR = bw->sr / sr; + susp->bw_n = 0; + susp->output_per_bw = sr / bw->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_aresonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization) +{ + sound_type s1_copy = sound_copy(s1); + sound_type hz1_copy = sound_copy(hz1); + sound_type bw_copy = sound_copy(bw); + return snd_make_aresonvv(s1_copy, hz1_copy, bw_copy, normalization); +} diff --git a/tran/aresonvv.h b/tran/aresonvv.h new file mode 100644 index 0000000..1aba1b6 --- /dev/null +++ b/tran/aresonvv.h @@ -0,0 +1,3 @@ +sound_type snd_make_aresonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization); +sound_type snd_aresonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization); + /* LISP: (snd-aresonvv SOUND SOUND SOUND FIXNUM) */ diff --git a/tran/atone.alg b/tran/atone.alg new file mode 100644 index 0000000..03b4d9f --- /dev/null +++ b/tran/atone.alg @@ -0,0 +1,20 @@ +(ATONE-ALG +(NAME "atone") +(ARGUMENTS ("sound_type" "s") ("double" "hz")) +(START (MIN s)) +(TERMINATE (MIN s)) +(LOGICAL-STOP (MIN s)) +(STATE ("double" "bb" "2.0 - cos(hz * PI2 / s->sr)" TEMP) + ("double" "cc" "bb - sqrt((bb * bb) - 1.0)") + ("double" "prev" "0.0")) +(CONSTANT "cc") +(INNER-LOOP-LOCALS " double current; +") +(INNER-LOOP "current = s; + prev = cc * (prev + current); /* use prev as temp variable ... */ + output = (float) prev; /* ... so we can do proper type conversion */ + prev -= current;") +; old code was: +; prev = (output = cc * (prev + current)) - current;") +) + diff --git a/tran/atone.c b/tran/atone.c new file mode 100644 index 0000000..2ff1f5d --- /dev/null +++ b/tran/atone.c @@ -0,0 +1,317 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "atone.h" + +void atone_free(); + + +typedef struct atone_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 cc; + double prev; +} atone_susp_node, *atone_susp_type; + + +void atone_n_fetch(register atone_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 double cc_reg; + register double prev_reg; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "atone_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); + /* 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; + cc_reg = susp->cc; + prev_reg = susp->prev; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double current; +current = *s_ptr_reg++; + prev_reg = cc_reg * (prev_reg + current); /* use prev_reg as temp variable ... */ + *out_ptr_reg++ = (float) prev_reg; /* ... so we can do proper type conversion */ + prev_reg -= current;; + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* 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; + } +} /* atone_n_fetch */ + + +void atone_s_fetch(register atone_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 double cc_reg; + register double prev_reg; + register sample_type s_scale_reg = susp->s->scale; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "atone_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 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); + /* 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; + cc_reg = susp->cc; + prev_reg = susp->prev; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double current; +current = (s_scale_reg * *s_ptr_reg++); + prev_reg = cc_reg * (prev_reg + current); /* use prev_reg as temp variable ... */ + *out_ptr_reg++ = (float) prev_reg; /* ... so we can do proper type conversion */ + prev_reg -= current;; + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* 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; + } +} /* atone_s_fetch */ + + +void atone_toss_fetch(susp, snd_list) + register atone_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while ((round((final_time - susp->s->t0) * susp->s->sr)) >= + 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 */ + 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; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void atone_mark(atone_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void atone_free(atone_susp_type susp) +{ + sound_unref(susp->s); + ffree_generic(susp, sizeof(atone_susp_node), "atone_free"); +} + + +void atone_print_tree(atone_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_atone(sound_type s, double hz) +{ + register atone_susp_type susp; + double bb; + rate_type sr = s->sr; + time_type t0 = s->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, atone_susp_node, "snd_make_atone"); + bb = 2.0 - cos(hz * PI2 / s->sr); + susp->cc = bb - sqrt((bb * bb) - 1.0); + susp->prev = 0.0; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = atone_n_fetch; break; + case INTERP_s: susp->susp.fetch = atone_s_fetch; break; + default: snd_badsr(); break; + } + + 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 = (long) ((t0 - t0_min) * sr + 0.5); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = atone_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = atone_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = atone_mark; + susp->susp.print_tree = atone_print_tree; + susp->susp.name = "atone"; + 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; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_atone(sound_type s, double hz) +{ + sound_type s_copy = sound_copy(s); + return snd_make_atone(s_copy, hz); +} diff --git a/tran/atone.h b/tran/atone.h new file mode 100644 index 0000000..9fa57d5 --- /dev/null +++ b/tran/atone.h @@ -0,0 +1,3 @@ +sound_type snd_make_atone(sound_type s, double hz); +sound_type snd_atone(sound_type s, double hz); + /* LISP: (snd-atone SOUND ANYNUM) */ diff --git a/tran/atonev.alg b/tran/atonev.alg new file mode 100644 index 0000000..441206f --- /dev/null +++ b/tran/atonev.alg @@ -0,0 +1,25 @@ +(ATONEV-ALG +(NAME "atonev") +(ARGUMENTS ("sound_type" "s1") ("sound_type" "hz")) +(INLINE-INTERPOLATION T) +(LINEAR hz) +(ALWAYS-SCALE hz) +(START (MAX s1 hz)) +(TERMINATE (MIN s1 hz)) +(LOGICAL-STOP (MIN s1)) +(STATE ("double" "cc" "0.0") + ("double" "prev" "0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr))")) +(LINEAR s1) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION hz) +(DEPENDS ("bb" "hz" "2.0 - cos(hz)" TEMP "register double") + ("cc" "hz" "bb - sqrt((bb * bb) - 1.0)")) +(CONSTANT "cc") +(INNER-LOOP-LOCALS " double current; +") +(INNER-LOOP "current = s1; + prev = cc * (prev + current); + output = (sample_type) prev; + prev -= current;") +) diff --git a/tran/atonev.c b/tran/atonev.c new file mode 100644 index 0000000..72532c6 --- /dev/null +++ b/tran/atonev.c @@ -0,0 +1,526 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "atonev.h" + +void atonev_free(); + + +typedef struct atonev_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type hz; + long hz_cnt; + sample_block_values_type hz_ptr; + + /* support for interpolation of hz */ + sample_type hz_x1_sample; + double hz_pHaSe; + double hz_pHaSe_iNcR; + + /* support for ramp between samples of hz */ + double output_per_hz; + long hz_n; + + double cc; + double prev; +} atonev_susp_node, *atonev_susp_type; + + +void atonev_ns_fetch(register atonev_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 double cc_reg; + register double prev_reg; + register sample_type hz_scale_reg = susp->hz->scale; + register sample_block_values_type hz_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "atonev_ns_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz input sample block: */ + susp_check_term_samples(hz, hz_ptr, hz_cnt); + togo = min(togo, susp->hz_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; + cc_reg = susp->cc; + prev_reg = susp->prev; + hz_ptr_reg = susp->hz_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double current; + register double bb; + bb = 2.0 - cos((hz_scale_reg * *hz_ptr_reg++)); + cc_reg = bb - sqrt((bb * bb) - 1.0); +current = *s1_ptr_reg++; + prev_reg = cc_reg * (prev_reg + current); + *out_ptr_reg++ = (sample_type) prev_reg; + prev_reg -= current;; + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* using hz_ptr_reg is a bad idea on RS/6000: */ + susp->hz_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz_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; + } +} /* atonev_ns_fetch */ + + +void atonev_ni_fetch(register atonev_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 double cc_reg; + register double prev_reg; + register double hz_pHaSe_iNcR_rEg = susp->hz_pHaSe_iNcR; + register double hz_pHaSe_ReG; + register sample_type hz_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "atonev_ni_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + register double bb; + susp->started = true; + susp_check_term_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + bb = 2.0 - cos(susp->hz_x1_sample); + susp->cc = bb - sqrt((bb * bb) - 1.0); + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + cc_reg = susp->cc; + prev_reg = susp->prev; + hz_pHaSe_ReG = susp->hz_pHaSe; + hz_x1_sample_reg = susp->hz_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double current; + if (hz_pHaSe_ReG >= 1.0) { +/* fixup-depends hz */ + register double bb; + /* pick up next sample as hz_x1_sample: */ + susp->hz_ptr++; + susp_took(hz_cnt, 1); + hz_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz, hz_ptr, hz_cnt, hz_x1_sample_reg); + hz_x1_sample_reg = susp_current_sample(hz, hz_ptr); + bb = 2.0 - cos(hz_x1_sample_reg); + cc_reg = susp->cc = bb - sqrt((bb * bb) - 1.0); + } +current = *s1_ptr_reg++; + prev_reg = cc_reg * (prev_reg + current); + *out_ptr_reg++ = (sample_type) prev_reg; + prev_reg -= current;; + hz_pHaSe_ReG += hz_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->prev = prev_reg; + susp->hz_pHaSe = hz_pHaSe_ReG; + susp->hz_x1_sample = hz_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* atonev_ni_fetch */ + + +void atonev_nr_fetch(register atonev_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double cc_reg; + register double prev_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "atonev_nr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz_pHaSe = 1.0; + } + + susp_check_term_samples(hz, hz_ptr, hz_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz_x1_sample when phase goes past 1.0; */ + /* use hz_n (computed below) to avoid roundoff errors: */ + if (susp->hz_n <= 0) { + register double bb; + susp_check_term_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->hz_pHaSe -= 1.0; + /* hz_n gets number of samples before phase exceeds 1.0: */ + susp->hz_n = (long) ((1.0 - susp->hz_pHaSe) * + susp->output_per_hz); + bb = 2.0 - cos(susp->hz_x1_sample); + susp->cc = bb - sqrt((bb * bb) - 1.0); + } + togo = min(togo, susp->hz_n); + hz_val = susp->hz_x1_sample; + /* 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; + cc_reg = susp->cc; + prev_reg = susp->prev; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double current; +current = *s1_ptr_reg++; + prev_reg = cc_reg * (prev_reg + current); + *out_ptr_reg++ = (sample_type) prev_reg; + prev_reg -= current;; + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz_pHaSe += togo * susp->hz_pHaSe_iNcR; + susp->hz_n -= 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; + } +} /* atonev_nr_fetch */ + + +void atonev_toss_fetch(susp, snd_list) + register atonev_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from hz up to final_time for this block of zeros */ + while ((round((final_time - susp->hz->t0) * susp->hz->sr)) >= + susp->hz->current) + susp_get_samples(hz, hz_ptr, hz_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->hz->t0) * susp->hz->sr - + (susp->hz->current - susp->hz_cnt)); + susp->hz_ptr += n; + susp_took(hz_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void atonev_mark(atonev_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->hz); +} + + +void atonev_free(atonev_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->hz); + ffree_generic(susp, sizeof(atonev_susp_node), "atonev_free"); +} + + +void atonev_print_tree(atonev_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("hz:"); + sound_print_tree_1(susp->hz, n); +} + + +sound_type snd_make_atonev(sound_type s1, sound_type hz) +{ + register atonev_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, hz->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (S1) */ + scale_factor *= s1->scale; + s1->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (s1->sr < sr) { s1->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, atonev_susp_node, "snd_make_atonev"); + susp->cc = 0.0; + susp->prev = 0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(hz, sr); + switch (interp_desc) { + case INTERP_nn: /* handled below */ + case INTERP_ns: susp->susp.fetch = atonev_ns_fetch; break; + case INTERP_ni: susp->susp.fetch = atonev_ni_fetch; break; + case INTERP_nr: susp->susp.fetch = atonev_nr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < hz->t0) sound_prepend_zeros(hz, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(hz->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 = atonev_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = atonev_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = atonev_mark; + susp->susp.print_tree = atonev_print_tree; + susp->susp.name = "atonev"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->hz = hz; + susp->hz_cnt = 0; + susp->hz_pHaSe = 0.0; + susp->hz_pHaSe_iNcR = hz->sr / sr; + susp->hz_n = 0; + susp->output_per_hz = sr / hz->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_atonev(sound_type s1, sound_type hz) +{ + sound_type s1_copy = sound_copy(s1); + sound_type hz_copy = sound_copy(hz); + return snd_make_atonev(s1_copy, hz_copy); +} diff --git a/tran/atonev.h b/tran/atonev.h new file mode 100644 index 0000000..9abcc2a --- /dev/null +++ b/tran/atonev.h @@ -0,0 +1,3 @@ +sound_type snd_make_atonev(sound_type s1, sound_type hz); +sound_type snd_atonev(sound_type s1, sound_type hz); + /* LISP: (snd-atonev SOUND SOUND) */ diff --git a/tran/biquadfilt.alg b/tran/biquadfilt.alg new file mode 100644 index 0000000..da2c75b --- /dev/null +++ b/tran/biquadfilt.alg @@ -0,0 +1,28 @@ +; general order-2 IIR filter. +; a0 is assumed to be unity. +; for a1 and a2, our sign convention is opposite to Matlab's. + +(SNDBIQUAD-ALG +(NAME "biquadfilt") +(LISPNAME "biquad") +(ARGUMENTS ("sound_type" "s") + ("double" "b0") ("double" "b1") ("double" "b2") + ("double" "a1") ("double" "a2") + ("double" "z1init") ("double" "z2init")) +(START (MIN s)) +(TERMINATE (MIN s)) +(LOGICAL-STOP (MIN s)) +(STATE ("double" "z1" "z1init") + ("double" "z2" "z2init") + ("double" "b0" "b0") + ("double" "b1" "b1") + ("double" "b2" "b2") + ("double" "a1" "a1") + ("double" "a2" "a2")) +(CONSTANT "b0" "b1" "b2" "a1" "a2") +(INNER-LOOP-LOCALS "double z0;") +(INNER-LOOP " z0 = s + a1*z1 + a2*z2; + output = (sample_type) (z0*b0 + z1*b1 + z2*b2); + z2 = z1; z1 = z0;") +) + diff --git a/tran/biquadfilt.c b/tran/biquadfilt.c new file mode 100644 index 0000000..c5e81da --- /dev/null +++ b/tran/biquadfilt.c @@ -0,0 +1,343 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "biquadfilt.h" + +void biquadfilt_free(); + + +typedef struct biquadfilt_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 z1; + double z2; + double b0; + double b1; + double b2; + double a1; + double a2; +} biquadfilt_susp_node, *biquadfilt_susp_type; + + +void biquadfilt_n_fetch(register biquadfilt_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 double z1_reg; + register double z2_reg; + register double b0_reg; + register double b1_reg; + register double b2_reg; + register double a1_reg; + register double a2_reg; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "biquadfilt_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); + /* 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; + z1_reg = susp->z1; + z2_reg = susp->z2; + b0_reg = susp->b0; + b1_reg = susp->b1; + b2_reg = susp->b2; + a1_reg = susp->a1; + a2_reg = susp->a2; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +double z0; z0 = *s_ptr_reg++ + a1_reg*z1_reg + a2_reg*z2_reg; + *out_ptr_reg++ = (sample_type) (z0*b0_reg + z1_reg*b1_reg + z2_reg*b2_reg); + z2_reg = z1_reg; z1_reg = z0;; + } while (--n); /* inner loop */ + + susp->z1 = z1_reg; + susp->z2 = z2_reg; + /* 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; + } +} /* biquadfilt_n_fetch */ + + +void biquadfilt_s_fetch(register biquadfilt_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 double z1_reg; + register double z2_reg; + register double b0_reg; + register double b1_reg; + register double b2_reg; + register double a1_reg; + register double a2_reg; + register sample_type s_scale_reg = susp->s->scale; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "biquadfilt_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 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); + /* 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; + z1_reg = susp->z1; + z2_reg = susp->z2; + b0_reg = susp->b0; + b1_reg = susp->b1; + b2_reg = susp->b2; + a1_reg = susp->a1; + a2_reg = susp->a2; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +double z0; z0 = (s_scale_reg * *s_ptr_reg++) + a1_reg*z1_reg + a2_reg*z2_reg; + *out_ptr_reg++ = (sample_type) (z0*b0_reg + z1_reg*b1_reg + z2_reg*b2_reg); + z2_reg = z1_reg; z1_reg = z0;; + } while (--n); /* inner loop */ + + susp->z1 = z1_reg; + susp->z2 = z2_reg; + /* 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; + } +} /* biquadfilt_s_fetch */ + + +void biquadfilt_toss_fetch(susp, snd_list) + register biquadfilt_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while ((round((final_time - susp->s->t0) * susp->s->sr)) >= + 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 */ + 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; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void biquadfilt_mark(biquadfilt_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void biquadfilt_free(biquadfilt_susp_type susp) +{ + sound_unref(susp->s); + ffree_generic(susp, sizeof(biquadfilt_susp_node), "biquadfilt_free"); +} + + +void biquadfilt_print_tree(biquadfilt_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_biquadfilt(sound_type s, double b0, double b1, double b2, double a1, double a2, double z1init, double z2init) +{ + register biquadfilt_susp_type susp; + rate_type sr = s->sr; + time_type t0 = s->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, biquadfilt_susp_node, "snd_make_biquadfilt"); + susp->z1 = z1init; + susp->z2 = z2init; + susp->b0 = b0; + susp->b1 = b1; + susp->b2 = b2; + susp->a1 = a1; + susp->a2 = a2; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = biquadfilt_n_fetch; break; + case INTERP_s: susp->susp.fetch = biquadfilt_s_fetch; break; + default: snd_badsr(); break; + } + + 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 = (long) ((t0 - t0_min) * sr + 0.5); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = biquadfilt_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = biquadfilt_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = biquadfilt_mark; + susp->susp.print_tree = biquadfilt_print_tree; + susp->susp.name = "biquadfilt"; + 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; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_biquadfilt(sound_type s, double b0, double b1, double b2, double a1, double a2, double z1init, double z2init) +{ + sound_type s_copy = sound_copy(s); + return snd_make_biquadfilt(s_copy, b0, b1, b2, a1, a2, z1init, z2init); +} diff --git a/tran/biquadfilt.h b/tran/biquadfilt.h new file mode 100644 index 0000000..e48addd --- /dev/null +++ b/tran/biquadfilt.h @@ -0,0 +1,3 @@ +sound_type snd_make_biquadfilt(sound_type s, double b0, double b1, double b2, double a1, double a2, double z1init, double z2init); +sound_type snd_biquadfilt(sound_type s, double b0, double b1, double b2, double a1, double a2, double z1init, double z2init); + /* LISP: (snd-biquad SOUND ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/buzz.alg b/tran/buzz.alg new file mode 100644 index 0000000..1bbf108 --- /dev/null +++ b/tran/buzz.alg @@ -0,0 +1,54 @@ +(BUZZ-ALG +(NAME "buzz") +(ARGUMENTS ("long" "n") ("rate_type" "sr") ("double" "hz") + ("time_type" "t0") ("sound_type" "s_fm")) +(SUPPORT-FUNCTIONS " +#include \"sine.h\" +") +(STATE ("double" "ph_incr" "0") + ("float" "n_2_r" "1.0F / (n * 2)") + ("float" "n_2_p1" "(n * 2) + 1") + ;; note: hz * 0.5 because this formula generates tones an octave up, + ;; we also have to correct for the modulation s_fm. If hz != 0, then + ;; ph_incr is the increment per hz, so ph_incr/hz is the right scale + ;; factor. If hz == 0, then the ph_incr/hz is SINE_TABLE_LEN * 0.5 / sr. + ("double" "phase" "compute_phase(PI*0.5, 69.0, SINE_TABLE_LEN, + SINE_TABLE_LEN * 440.0, sr, hz * 0.5, &susp->ph_incr); + s_fm->scale *= hz != 0 ? (sample_type) (susp->ph_incr / hz) + : (sample_type) (SINE_TABLE_LEN * 0.5 / sr)")) ;cancel 0/0 + +(ALWAYS-SCALE s_fm) +(INLINE-INTERPOLATION T) ; so that modulation can be low frequency +(STEP-FUNCTION s_fm) +(TERMINATE (MIN s_fm)) +(LOGICAL-STOP (MIN s_fm)) +(INNER-LOOP-LOCALS " long table_index; + double x1; + sample_type num, denom, samp; +") +(INNER-LOOP " + table_index = (long) phase; + x1 = sine_table[table_index]; + denom = (sample_type) (x1 + (phase - table_index) * + (sine_table[table_index + 1] - x1)); + if (denom < 0.001 && denom > -0.005) { + samp = 1.0F; + } else { + double phn2p1 = phase * n_2_p1 * (1.0/SINE_TABLE_LEN); + phn2p1 = (phn2p1 - (long) phn2p1) * SINE_TABLE_LEN; + table_index = (long) phn2p1; + x1 = sine_table[table_index]; + num = (sample_type) (x1 + (phn2p1 - table_index) * + (sine_table[table_index + 1] - x1)); + samp = ((num / denom) - 1.0F) * n_2_r; + } + output = samp; + phase += ph_incr + s_fm; + while (phase > SINE_TABLE_LEN) phase -= SINE_TABLE_LEN; + /* watch out for negative frequencies! */ + while (phase < 0) phase += SINE_TABLE_LEN") +(CONSTANT "ph_incr" "n_2_p1" "n_2_r") + +(SAMPLE-RATE "sr") +) + diff --git a/tran/buzz.c b/tran/buzz.c new file mode 100644 index 0000000..5619811 --- /dev/null +++ b/tran/buzz.c @@ -0,0 +1,536 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "buzz.h" + +void buzz_free(); + + +typedef struct buzz_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s_fm; + long s_fm_cnt; + sample_block_values_type s_fm_ptr; + + /* support for interpolation of s_fm */ + sample_type s_fm_x1_sample; + double s_fm_pHaSe; + double s_fm_pHaSe_iNcR; + + /* support for ramp between samples of s_fm */ + double output_per_s_fm; + long s_fm_n; + + double ph_incr; + float n_2_r; + float n_2_p1; + double phase; +} buzz_susp_node, *buzz_susp_type; + + +#include "sine.h" + + +void buzz_s_fetch(register buzz_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 double ph_incr_reg; + register float n_2_r_reg; + register float n_2_p1_reg; + register double phase_reg; + register sample_type s_fm_scale_reg = susp->s_fm->scale; + register sample_block_values_type s_fm_ptr_reg; + falloc_sample_block(out, "buzz_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 s_fm input sample block: */ + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + togo = min(togo, susp->s_fm_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; + ph_incr_reg = susp->ph_incr; + n_2_r_reg = susp->n_2_r; + n_2_p1_reg = susp->n_2_p1; + phase_reg = susp->phase; + s_fm_ptr_reg = susp->s_fm_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; + sample_type num, denom, samp; + + table_index = (long) phase_reg; + x1 = sine_table[table_index]; + denom = (sample_type) (x1 + (phase_reg - table_index) * + (sine_table[table_index + 1] - x1)); + if (denom < 0.001 && denom > -0.005) { + samp = 1.0F; + } else { + double phn2p1 = phase_reg * n_2_p1_reg * (1.0/SINE_TABLE_LEN); + phn2p1 = (phn2p1 - (long) phn2p1) * SINE_TABLE_LEN; + table_index = (long) phn2p1; + x1 = sine_table[table_index]; + num = (sample_type) (x1 + (phn2p1 - table_index) * + (sine_table[table_index + 1] - x1)); + samp = ((num / denom) - 1.0F) * n_2_r_reg; + } + *out_ptr_reg++ = samp; + phase_reg += ph_incr_reg + (s_fm_scale_reg * *s_fm_ptr_reg++); + while (phase_reg > SINE_TABLE_LEN) phase_reg -= SINE_TABLE_LEN; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += SINE_TABLE_LEN; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + /* using s_fm_ptr_reg is a bad idea on RS/6000: */ + susp->s_fm_ptr += togo; + out_ptr += togo; + susp_took(s_fm_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; + } +} /* buzz_s_fetch */ + + +void buzz_i_fetch(register buzz_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 double ph_incr_reg; + register float n_2_r_reg; + register float n_2_p1_reg; + register double phase_reg; + register double s_fm_pHaSe_iNcR_rEg = susp->s_fm_pHaSe_iNcR; + register double s_fm_pHaSe_ReG; + register sample_type s_fm_x1_sample_reg; + falloc_sample_block(out, "buzz_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_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + } + + 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); + /* 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; + ph_incr_reg = susp->ph_incr; + n_2_r_reg = susp->n_2_r; + n_2_p1_reg = susp->n_2_p1; + phase_reg = susp->phase; + s_fm_pHaSe_ReG = susp->s_fm_pHaSe; + s_fm_x1_sample_reg = susp->s_fm_x1_sample; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; + sample_type num, denom, samp; + if (s_fm_pHaSe_ReG >= 1.0) { +/* fixup-depends s_fm */ + /* pick up next sample as s_fm_x1_sample: */ + susp->s_fm_ptr++; + susp_took(s_fm_cnt, 1); + s_fm_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(s_fm, s_fm_ptr, s_fm_cnt, s_fm_x1_sample_reg); + s_fm_x1_sample_reg = susp_current_sample(s_fm, s_fm_ptr); + } + + table_index = (long) phase_reg; + x1 = sine_table[table_index]; + denom = (sample_type) (x1 + (phase_reg - table_index) * + (sine_table[table_index + 1] - x1)); + if (denom < 0.001 && denom > -0.005) { + samp = 1.0F; + } else { + double phn2p1 = phase_reg * n_2_p1_reg * (1.0/SINE_TABLE_LEN); + phn2p1 = (phn2p1 - (long) phn2p1) * SINE_TABLE_LEN; + table_index = (long) phn2p1; + x1 = sine_table[table_index]; + num = (sample_type) (x1 + (phn2p1 - table_index) * + (sine_table[table_index + 1] - x1)); + samp = ((num / denom) - 1.0F) * n_2_r_reg; + } + *out_ptr_reg++ = samp; + phase_reg += ph_incr_reg + s_fm_x1_sample_reg; + while (phase_reg > SINE_TABLE_LEN) phase_reg -= SINE_TABLE_LEN; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += SINE_TABLE_LEN; + s_fm_pHaSe_ReG += s_fm_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->phase = phase_reg; + susp->s_fm_pHaSe = s_fm_pHaSe_ReG; + susp->s_fm_x1_sample = s_fm_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; + } +} /* buzz_i_fetch */ + + +void buzz_r_fetch(register buzz_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type s_fm_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double ph_incr_reg; + register float n_2_r_reg; + register float n_2_p1_reg; + register double phase_reg; + falloc_sample_block(out, "buzz_r_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->s_fm_pHaSe = 1.0; + } + + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + + 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; + + /* grab next s_fm_x1_sample when phase goes past 1.0; */ + /* use s_fm_n (computed below) to avoid roundoff errors: */ + if (susp->s_fm_n <= 0) { + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_pHaSe -= 1.0; + /* s_fm_n gets number of samples before phase exceeds 1.0: */ + susp->s_fm_n = (long) ((1.0 - susp->s_fm_pHaSe) * + susp->output_per_s_fm); + } + togo = min(togo, susp->s_fm_n); + s_fm_val = susp->s_fm_x1_sample; + /* 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; + ph_incr_reg = susp->ph_incr; + n_2_r_reg = susp->n_2_r; + n_2_p1_reg = susp->n_2_p1; + phase_reg = susp->phase; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; + sample_type num, denom, samp; + + table_index = (long) phase_reg; + x1 = sine_table[table_index]; + denom = (sample_type) (x1 + (phase_reg - table_index) * + (sine_table[table_index + 1] - x1)); + if (denom < 0.001 && denom > -0.005) { + samp = 1.0F; + } else { + double phn2p1 = phase_reg * n_2_p1_reg * (1.0/SINE_TABLE_LEN); + phn2p1 = (phn2p1 - (long) phn2p1) * SINE_TABLE_LEN; + table_index = (long) phn2p1; + x1 = sine_table[table_index]; + num = (sample_type) (x1 + (phn2p1 - table_index) * + (sine_table[table_index + 1] - x1)); + samp = ((num / denom) - 1.0F) * n_2_r_reg; + } + *out_ptr_reg++ = samp; + phase_reg += ph_incr_reg + s_fm_val; + while (phase_reg > SINE_TABLE_LEN) phase_reg -= SINE_TABLE_LEN; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += SINE_TABLE_LEN; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + out_ptr += togo; + susp->s_fm_pHaSe += togo * susp->s_fm_pHaSe_iNcR; + susp->s_fm_n -= 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; + } +} /* buzz_r_fetch */ + + +void buzz_toss_fetch(susp, snd_list) + register buzz_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s_fm up to final_time for this block of zeros */ + while ((round((final_time - susp->s_fm->t0) * susp->s_fm->sr)) >= + susp->s_fm->current) + susp_get_samples(s_fm, s_fm_ptr, s_fm_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s_fm->t0) * susp->s_fm->sr - + (susp->s_fm->current - susp->s_fm_cnt)); + susp->s_fm_ptr += n; + susp_took(s_fm_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void buzz_mark(buzz_susp_type susp) +{ + sound_xlmark(susp->s_fm); +} + + +void buzz_free(buzz_susp_type susp) +{ + sound_unref(susp->s_fm); + ffree_generic(susp, sizeof(buzz_susp_node), "buzz_free"); +} + + +void buzz_print_tree(buzz_susp_type susp, int n) +{ + indent(n); + stdputstr("s_fm:"); + sound_print_tree_1(susp->s_fm, n); +} + + +sound_type snd_make_buzz(long n, rate_type sr, double hz, time_type t0, sound_type s_fm) +{ + register buzz_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, buzz_susp_node, "snd_make_buzz"); + susp->ph_incr = 0; + susp->n_2_r = 1.0F / (n * 2); + susp->n_2_p1 = (n * 2) + 1; + susp->phase = compute_phase(PI*0.5, 69.0, SINE_TABLE_LEN, + SINE_TABLE_LEN * 440.0, sr, hz * 0.5, &susp->ph_incr); + s_fm->scale *= hz != 0 ? (sample_type) (susp->ph_incr / hz) + : (sample_type) (SINE_TABLE_LEN * 0.5 / sr); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s_fm, sr); + switch (interp_desc) { + case INTERP_n: /* handled below */ + case INTERP_s: susp->susp.fetch = buzz_s_fetch; break; + case INTERP_i: susp->susp.fetch = buzz_i_fetch; break; + case INTERP_r: susp->susp.fetch = buzz_r_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s_fm->t0) sound_prepend_zeros(s_fm, t0); + /* minimum start time over all inputs: */ + t0_min = min(s_fm->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 = buzz_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = buzz_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = buzz_mark; + susp->susp.print_tree = buzz_print_tree; + susp->susp.name = "buzz"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s_fm); + susp->started = false; + susp->susp.current = 0; + susp->s_fm = s_fm; + susp->s_fm_cnt = 0; + susp->s_fm_pHaSe = 0.0; + susp->s_fm_pHaSe_iNcR = s_fm->sr / sr; + susp->s_fm_n = 0; + susp->output_per_s_fm = sr / s_fm->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_buzz(long n, rate_type sr, double hz, time_type t0, sound_type s_fm) +{ + sound_type s_fm_copy = sound_copy(s_fm); + return snd_make_buzz(n, sr, hz, t0, s_fm_copy); +} diff --git a/tran/buzz.h b/tran/buzz.h new file mode 100644 index 0000000..466c7f3 --- /dev/null +++ b/tran/buzz.h @@ -0,0 +1,3 @@ +sound_type snd_make_buzz(long n, rate_type sr, double hz, time_type t0, sound_type s_fm); +sound_type snd_buzz(long n, rate_type sr, double hz, time_type t0, sound_type s_fm); + /* LISP: (snd-buzz FIXNUM ANYNUM ANYNUM ANYNUM SOUND) */ diff --git a/tran/chase.alg b/tran/chase.alg new file mode 100644 index 0000000..dd4b0c1 --- /dev/null +++ b/tran/chase.alg @@ -0,0 +1,19 @@ +(CHASE-ALG + (NAME "chase") + (ARGUMENTS ("sound_type" "input") ("double" "risetime") ("double" "falltime")) + (STATE ("double" "level" "0.0") + ("double" "upslope" "1.0/(input->sr * risetime)") + ("double" "downslope" "1.0/(input->sr * falltime)")) + (START (MIN input)) + (INNER-LOOP " double x = input; + if (x > level) { + level += upslope; + if (x < level) level = x; + } else { + level -= downslope; + if (x > level) level = x; + } + output = (sample_type) level;") + (TERMINATE (MIN input)) + (LOGICAL-STOP (MIN input)) +) diff --git a/tran/chase.c b/tran/chase.c new file mode 100644 index 0000000..30d664a --- /dev/null +++ b/tran/chase.c @@ -0,0 +1,333 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "chase.h" + +void chase_free(); + + +typedef struct chase_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + double level; + double upslope; + double downslope; +} chase_susp_node, *chase_susp_type; + + +void chase_n_fetch(register chase_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 double level_reg; + register double upslope_reg; + register double downslope_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "chase_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + level_reg = susp->level; + upslope_reg = susp->upslope; + downslope_reg = susp->downslope; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double x = *input_ptr_reg++; + if (x > level_reg) { + level_reg += upslope_reg; + if (x < level_reg) level_reg = x; + } else { + level_reg -= downslope_reg; + if (x > level_reg) level_reg = x; + } + *out_ptr_reg++ = (sample_type) level_reg;; + } while (--n); /* inner loop */ + + susp->level = level_reg; + susp->upslope = upslope_reg; + susp->downslope = downslope_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* chase_n_fetch */ + + +void chase_s_fetch(register chase_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 double level_reg; + register double upslope_reg; + register double downslope_reg; + register sample_type input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "chase_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + level_reg = susp->level; + upslope_reg = susp->upslope; + downslope_reg = susp->downslope; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double x = (input_scale_reg * *input_ptr_reg++); + if (x > level_reg) { + level_reg += upslope_reg; + if (x < level_reg) level_reg = x; + } else { + level_reg -= downslope_reg; + if (x > level_reg) level_reg = x; + } + *out_ptr_reg++ = (sample_type) level_reg;; + } while (--n); /* inner loop */ + + susp->level = level_reg; + susp->upslope = upslope_reg; + susp->downslope = downslope_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* chase_s_fetch */ + + +void chase_toss_fetch(susp, snd_list) + register chase_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void chase_mark(chase_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void chase_free(chase_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(chase_susp_node), "chase_free"); +} + + +void chase_print_tree(chase_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_chase(sound_type input, double risetime, double falltime) +{ + register chase_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, chase_susp_node, "snd_make_chase"); + susp->level = 0.0; + susp->upslope = 1.0/(input->sr * risetime); + susp->downslope = 1.0/(input->sr * falltime); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(input, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = chase_n_fetch; break; + case INTERP_s: susp->susp.fetch = chase_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = chase_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = chase_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = chase_mark; + susp->susp.print_tree = chase_print_tree; + susp->susp.name = "chase"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_chase(sound_type input, double risetime, double falltime) +{ + sound_type input_copy = sound_copy(input); + return snd_make_chase(input_copy, risetime, falltime); +} diff --git a/tran/chase.h b/tran/chase.h new file mode 100644 index 0000000..a63112e --- /dev/null +++ b/tran/chase.h @@ -0,0 +1,3 @@ +sound_type snd_make_chase(sound_type input, double risetime, double falltime); +sound_type snd_chase(sound_type input, double risetime, double falltime); + /* LISP: (snd-chase SOUND ANYNUM ANYNUM) */ diff --git a/tran/clip.alg b/tran/clip.alg new file mode 100644 index 0000000..1bf56fe --- /dev/null +++ b/tran/clip.alg @@ -0,0 +1,9 @@ +(CLIP-ALG + (NAME "clip") + (ARGUMENTS ("sound_type" "s") ("double" "level")) + (STATE ("sample_type" "level" "(sample_type) level")) + (START (MIN s)) + (INNER-LOOP "double x = s; output = (sample_type) (x > level ? level : (x < -level ? -level : x))") + (TERMINATE (MIN s)) + (LOGICAL-STOP (MIN s)) +) diff --git a/tran/clip.c b/tran/clip.c new file mode 100644 index 0000000..e6a5bec --- /dev/null +++ b/tran/clip.c @@ -0,0 +1,301 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "clip.h" + +void clip_free(); + + +typedef struct clip_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + + sample_type level; +} clip_susp_node, *clip_susp_type; + + +void clip_n_fetch(register clip_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 level_reg; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "clip_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); + /* 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; + level_reg = susp->level; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +double x = *s_ptr_reg++; *out_ptr_reg++ = (sample_type) (x > level_reg ? level_reg : (x < -level_reg ? -level_reg : x)); + } while (--n); /* inner loop */ + + susp->level = level_reg; + /* 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; + } +} /* clip_n_fetch */ + + +void clip_s_fetch(register clip_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 level_reg; + register sample_type s_scale_reg = susp->s->scale; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "clip_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 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); + /* 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; + level_reg = susp->level; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +double x = (s_scale_reg * *s_ptr_reg++); *out_ptr_reg++ = (sample_type) (x > level_reg ? level_reg : (x < -level_reg ? -level_reg : x)); + } while (--n); /* inner loop */ + + susp->level = level_reg; + /* 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; + } +} /* clip_s_fetch */ + + +void clip_toss_fetch(susp, snd_list) + register clip_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while ((round((final_time - susp->s->t0) * susp->s->sr)) >= + 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 */ + 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; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void clip_mark(clip_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void clip_free(clip_susp_type susp) +{ + sound_unref(susp->s); + ffree_generic(susp, sizeof(clip_susp_node), "clip_free"); +} + + +void clip_print_tree(clip_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_clip(sound_type s, double level) +{ + register clip_susp_type susp; + rate_type sr = s->sr; + time_type t0 = s->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, clip_susp_node, "snd_make_clip"); + susp->level = (sample_type) level; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = clip_n_fetch; break; + case INTERP_s: susp->susp.fetch = clip_s_fetch; break; + default: snd_badsr(); break; + } + + 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 = (long) ((t0 - t0_min) * sr + 0.5); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = clip_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = clip_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = clip_mark; + susp->susp.print_tree = clip_print_tree; + susp->susp.name = "clip"; + 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; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_clip(sound_type s, double level) +{ + sound_type s_copy = sound_copy(s); + return snd_make_clip(s_copy, level); +} diff --git a/tran/clip.h b/tran/clip.h new file mode 100644 index 0000000..1b28307 --- /dev/null +++ b/tran/clip.h @@ -0,0 +1,3 @@ +sound_type snd_make_clip(sound_type s, double level); +sound_type snd_clip(sound_type s, double level); + /* LISP: (snd-clip SOUND ANYNUM) */ diff --git a/tran/congen.alg b/tran/congen.alg new file mode 100644 index 0000000..9ff02d2 --- /dev/null +++ b/tran/congen.alg @@ -0,0 +1,17 @@ +(CONGEN +(NAME "congen") +(ARGUMENTS ("sound_type" "sndin") ("double" "risetime") ("double" "falltime")) +(START (MIN sndin)) +(STATE ("double" "value" "0") + ("double" "rise_factor" "exp(log(0.5) / (sndin->sr * risetime))") + ("double" "fall_factor" "exp(log(0.5) / (sndin->sr * falltime))")) +(CONSTANT "fall_factor" "rise_factor") +(ALWAYS-SCALE sndin) +(TERMINATE (MIN sndin)) +(INNER-LOOP " sample_type current = sndin; + if (current > value) { + value = current - (current - value) * rise_factor; + } else { + value = current - (current - value) * fall_factor; + } + output = (sample_type) value;")) diff --git a/tran/congen.c b/tran/congen.c new file mode 100644 index 0000000..ed074c7 --- /dev/null +++ b/tran/congen.c @@ -0,0 +1,185 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "congen.h" + +void congen_free(); + + +typedef struct congen_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type sndin; + long sndin_cnt; + sample_block_values_type sndin_ptr; + + double value; + double rise_factor; + double fall_factor; +} congen_susp_node, *congen_susp_type; + + +void congen_s_fetch(register congen_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 double value_reg; + register double rise_factor_reg; + register double fall_factor_reg; + register sample_type sndin_scale_reg = susp->sndin->scale; + register sample_block_values_type sndin_ptr_reg; + falloc_sample_block(out, "congen_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 sndin input sample block: */ + susp_check_term_samples(sndin, sndin_ptr, sndin_cnt); + togo = min(togo, susp->sndin_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; + value_reg = susp->value; + rise_factor_reg = susp->rise_factor; + fall_factor_reg = susp->fall_factor; + sndin_ptr_reg = susp->sndin_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + sample_type current = (sndin_scale_reg * *sndin_ptr_reg++); + if (current > value_reg) { + value_reg = current - (current - value_reg) * rise_factor_reg; + } else { + value_reg = current - (current - value_reg) * fall_factor_reg; + } + *out_ptr_reg++ = (sample_type) value_reg;; + } while (--n); /* inner loop */ + + susp->value = value_reg; + /* using sndin_ptr_reg is a bad idea on RS/6000: */ + susp->sndin_ptr += togo; + out_ptr += togo; + susp_took(sndin_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; + } +} /* congen_s_fetch */ + + +void congen_toss_fetch(susp, snd_list) + register congen_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from sndin up to final_time for this block of zeros */ + while ((round((final_time - susp->sndin->t0) * susp->sndin->sr)) >= + susp->sndin->current) + susp_get_samples(sndin, sndin_ptr, sndin_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->sndin->t0) * susp->sndin->sr - + (susp->sndin->current - susp->sndin_cnt)); + susp->sndin_ptr += n; + susp_took(sndin_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void congen_mark(congen_susp_type susp) +{ + sound_xlmark(susp->sndin); +} + + +void congen_free(congen_susp_type susp) +{ + sound_unref(susp->sndin); + ffree_generic(susp, sizeof(congen_susp_node), "congen_free"); +} + + +void congen_print_tree(congen_susp_type susp, int n) +{ + indent(n); + stdputstr("sndin:"); + sound_print_tree_1(susp->sndin, n); +} + + +sound_type snd_make_congen(sound_type sndin, double risetime, double falltime) +{ + register congen_susp_type susp; + rate_type sr = sndin->sr; + time_type t0 = sndin->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, congen_susp_node, "snd_make_congen"); + susp->value = 0; + susp->rise_factor = exp(log(0.5) / (sndin->sr * risetime)); + susp->fall_factor = exp(log(0.5) / (sndin->sr * falltime)); + susp->susp.fetch = congen_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < sndin->t0) sound_prepend_zeros(sndin, t0); + /* minimum start time over all inputs: */ + t0_min = min(sndin->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 = congen_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = congen_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = congen_mark; + susp->susp.print_tree = congen_print_tree; + susp->susp.name = "congen"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->sndin = sndin; + susp->sndin_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_congen(sound_type sndin, double risetime, double falltime) +{ + sound_type sndin_copy = sound_copy(sndin); + return snd_make_congen(sndin_copy, risetime, falltime); +} diff --git a/tran/congen.h b/tran/congen.h new file mode 100644 index 0000000..dd336b2 --- /dev/null +++ b/tran/congen.h @@ -0,0 +1,3 @@ +sound_type snd_make_congen(sound_type sndin, double risetime, double falltime); +sound_type snd_congen(sound_type sndin, double risetime, double falltime); + /* LISP: (snd-congen SOUND ANYNUM ANYNUM) */ diff --git a/tran/const.alg b/tran/const.alg new file mode 100644 index 0000000..3d89b09 --- /dev/null +++ b/tran/const.alg @@ -0,0 +1,11 @@ +(CONST-ALG +(NAME "const") +(ARGUMENTS ("double" "c") ("time_type" "t0") + ("rate_type" "sr") ("time_type" "d")) +(STATE ("sample_type" "c" "(sample_type) c")) +(CONSTANT "c") +(TERMINATE (AFTER "d")) +(INNER-LOOP "output = c") +(SAMPLE-RATE "sr") +) + diff --git a/tran/const.c b/tran/const.c new file mode 100644 index 0000000..042cd52 --- /dev/null +++ b/tran/const.c @@ -0,0 +1,109 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "const.h" + +void const_free(); + + +typedef struct const_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + sample_type c; +} const_susp_node, *const_susp_type; + + +void const__fetch(register const_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; + falloc_sample_block(out, "const__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; + } + + n = togo; + c_reg = susp->c; + 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 */ + + /* test for termination */ + if (togo == 0 && cnt == 0) { + snd_list_terminate(snd_list); + } else { + snd_list->block_len = cnt; + susp->susp.current += cnt; + } +} /* const__fetch */ + + +void const_free(const_susp_type susp) +{ + ffree_generic(susp, sizeof(const_susp_node), "const_free"); +} + + +void const_print_tree(const_susp_type susp, int n) +{ +} + + +sound_type snd_make_const(double c, time_type t0, rate_type sr, time_type d) +{ + register const_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, const_susp_node, "snd_make_const"); + susp->c = (sample_type) c; + susp->susp.fetch = const__fetch; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = const_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = const_print_tree; + susp->susp.name = "const"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_const(double c, time_type t0, rate_type sr, time_type d) +{ + return snd_make_const(c, t0, sr, d); +} diff --git a/tran/const.h b/tran/const.h new file mode 100644 index 0000000..e29a167 --- /dev/null +++ b/tran/const.h @@ -0,0 +1,3 @@ +sound_type snd_make_const(double c, time_type t0, rate_type sr, time_type d); +sound_type snd_const(double c, time_type t0, rate_type sr, time_type d); + /* LISP: (snd-const ANYNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/convolve.alg b/tran/convolve.alg new file mode 100644 index 0000000..94107b4 --- /dev/null +++ b/tran/convolve.alg @@ -0,0 +1,63 @@ +(CONVOLVE-ALG +(NAME "convolve") +(SUPPORT-FUNCTIONS " +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--; + } +} +") + +(ARGUMENTS ("sound_type" "x_snd") ("sound_type" "h_snd") ) +(TABLE "h_snd") +(START (MIN x_snd)) +(NOT-IN-INNER-LOOP "h_snd") +(STATE + ("table_type" "table" "sound_to_table(h_snd)") + ("sample_type *" "h_buf" "susp->table->samples") + ("double" "length_of_h" "susp->table->length") + ("long" "h_len" "(long) susp->length_of_h; + h_reverse(susp->h_buf, susp->h_len)") + ("long" "x_buf_len" "2 * susp->h_len") + ("sample_type *" "x_buffer_pointer" + "calloc((2 * (susp->h_len)), sizeof(float))") + ("sample_type *" "x_buffer_current" "susp->x_buffer_pointer") ) +(ALWAYS-SCALE x_snd) +(TERMINATE (MIN x_snd)) +(LOGICAL-STOP (MIN x_snd)) +(INNER-LOOP-LOCALS + "long i; double sum;") +(INNER-LOOP " + /* see if we've reached end of x_buffer */ + if ((x_buffer_pointer + x_buf_len) <= (x_buffer_current + h_len)) { + /* shift x_buffer from current back to base */ + for (i = 1; i < h_len; i++) { + x_buffer_pointer[i-1] = x_buffer_current[i]; + } + /* this will be incremented back to x_buffer_pointer below */ + x_buffer_current = x_buffer_pointer - 1; + } + + x_buffer_current++; + + x_buffer_current[h_len - 1] = x_snd; + + sum = 0.0; + for (i = 0; i < h_len; i++) { + sum += x_buffer_current[i] * h_buf[i]; + } + + output = (sample_type) sum; +") +(CONSTANT "h_buf" "h_len" "x_buf_len" "table") +(SAMPLE-RATE "x_snd->sr") +(FINALIZATION " table_unref(susp->table); + free(susp->x_buffer_pointer);") +) diff --git a/tran/coterm.alg b/tran/coterm.alg new file mode 100644 index 0000000..84bce1d --- /dev/null +++ b/tran/coterm.alg @@ -0,0 +1,11 @@ +(COTERM-ALG + (NAME "coterm") + (ARGUMENTS ("sound_type" "s1") ("sound_type" "s2")) + (START (MAX s1 s2)) + (INNER-LOOP "{sample_type dummy = s2; output = s1;}") + (LINEAR s1) + (TERMINATE (MIN s1 s2)) + (LOGICAL-STOP (MIN s1 s2)) + (INTERNAL-SCALING s2) +) + diff --git a/tran/coterm.c b/tran/coterm.c new file mode 100644 index 0000000..dfc4a1d --- /dev/null +++ b/tran/coterm.c @@ -0,0 +1,238 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "coterm.h" + +void coterm_free(); + + +typedef struct coterm_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type s2; + long s2_cnt; + sample_block_values_type s2_ptr; +} coterm_susp_node, *coterm_susp_type; + + +void coterm_nn_fetch(register coterm_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 s2_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "coterm_nn_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the s2 input sample block: */ + susp_check_term_log_samples(s2, s2_ptr, s2_cnt); + togo = min(togo, susp->s2_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; + s2_ptr_reg = susp->s2_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{sample_type dummy = *s2_ptr_reg++; *out_ptr_reg++ = *s1_ptr_reg++;}; + } while (--n); /* inner loop */ + + /* using s2_ptr_reg is a bad idea on RS/6000: */ + susp->s2_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(s2_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; + } +} /* coterm_nn_fetch */ + + +void coterm_toss_fetch(susp, snd_list) + register coterm_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from s2 up to final_time for this block of zeros */ + while ((round((final_time - susp->s2->t0) * susp->s2->sr)) >= + susp->s2->current) + susp_get_samples(s2, s2_ptr, s2_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->s2->t0) * susp->s2->sr - + (susp->s2->current - susp->s2_cnt)); + susp->s2_ptr += n; + susp_took(s2_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void coterm_mark(coterm_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->s2); +} + + +void coterm_free(coterm_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->s2); + ffree_generic(susp, sizeof(coterm_susp_node), "coterm_free"); +} + + +void coterm_print_tree(coterm_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("s2:"); + sound_print_tree_1(susp->s2, n); +} + + +sound_type snd_make_coterm(sound_type s1, sound_type s2) +{ + register coterm_susp_type susp; + rate_type sr = max(s1->sr, s2->sr); + time_type t0 = max(s1->t0, s2->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + long lsc; + /* combine scale factors of linear inputs (S1) */ + scale_factor *= s1->scale; + s1->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (s1->sr < sr) { s1->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, coterm_susp_node, "snd_make_coterm"); + susp->susp.fetch = coterm_nn_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < s2->t0) sound_prepend_zeros(s2, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(s2->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 = coterm_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = coterm_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = coterm_mark; + susp->susp.print_tree = coterm_print_tree; + susp->susp.name = "coterm"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + lsc = logical_stop_cnt_cvt(s2); + if (susp->susp.log_stop_cnt > lsc) + susp->susp.log_stop_cnt = lsc; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->s2 = s2; + susp->s2_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_coterm(sound_type s1, sound_type s2) +{ + sound_type s1_copy = sound_copy(s1); + sound_type s2_copy = sound_copy(s2); + return snd_make_coterm(s1_copy, s2_copy); +} diff --git a/tran/coterm.h b/tran/coterm.h new file mode 100644 index 0000000..629678d --- /dev/null +++ b/tran/coterm.h @@ -0,0 +1,3 @@ +sound_type snd_make_coterm(sound_type s1, sound_type s2); +sound_type snd_coterm(sound_type s1, sound_type s2); + /* LISP: (snd-coterm SOUND SOUND) */ diff --git a/tran/delay.alg b/tran/delay.alg new file mode 100644 index 0000000..8e2d502 --- /dev/null +++ b/tran/delay.alg @@ -0,0 +1,20 @@ +(DELAY-ALG +(NAME "delay") +(ARGUMENTS ("sound_type" "input") ("time_type" "delay") ("double" "feedback")) +(START (MIN input)) +(STATE ("double" "feedback" "feedback") + ("long" "delaylen" "max(1, round(input->sr * delay))") + ("sample_type *" "delaybuf" + "(sample_type *) calloc (susp->delaylen, sizeof(sample_type))") + ("sample_type *" "delayptr" "susp->delaybuf") + ("sample_type *" "endptr" "susp->delaybuf + susp->delaylen")) +(CONSTANT "feedback" "delaylen" "endptr") +(NOT-REGISTER delaybuf) +(LINEAR input) +(TERMINATE (MIN input)) +(INNER-LOOP "output = *delayptr; + *delayptr = (sample_type) (*delayptr * feedback) + input; + if (++delayptr >= endptr) delayptr = susp->delaybuf;") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/delaycc.alg b/tran/delaycc.alg new file mode 100644 index 0000000..8e2d502 --- /dev/null +++ b/tran/delaycc.alg @@ -0,0 +1,20 @@ +(DELAY-ALG +(NAME "delay") +(ARGUMENTS ("sound_type" "input") ("time_type" "delay") ("double" "feedback")) +(START (MIN input)) +(STATE ("double" "feedback" "feedback") + ("long" "delaylen" "max(1, round(input->sr * delay))") + ("sample_type *" "delaybuf" + "(sample_type *) calloc (susp->delaylen, sizeof(sample_type))") + ("sample_type *" "delayptr" "susp->delaybuf") + ("sample_type *" "endptr" "susp->delaybuf + susp->delaylen")) +(CONSTANT "feedback" "delaylen" "endptr") +(NOT-REGISTER delaybuf) +(LINEAR input) +(TERMINATE (MIN input)) +(INNER-LOOP "output = *delayptr; + *delayptr = (sample_type) (*delayptr * feedback) + input; + if (++delayptr >= endptr) delayptr = susp->delaybuf;") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/delaycc.c b/tran/delaycc.c new file mode 100644 index 0000000..3584d89 --- /dev/null +++ b/tran/delaycc.c @@ -0,0 +1,191 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "delaycc.h" + +void delay_free(); + + +typedef struct delay_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + double feedback; + long delaylen; + sample_type *delaybuf; + sample_type *delayptr; + sample_type *endptr; +} delay_susp_node, *delay_susp_type; + + +void delay_n_fetch(register delay_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 double feedback_reg; + register sample_type * delayptr_reg; + register sample_type * endptr_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "delay_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 input input sample block: */ + susp_check_term_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + feedback_reg = susp->feedback; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = *delayptr_reg; + *delayptr_reg = (sample_type) (*delayptr_reg * feedback_reg) + *input_ptr_reg++; + if (++delayptr_reg >= endptr_reg) delayptr_reg = susp->delaybuf;; + } while (--n); /* inner loop */ + + susp->delayptr = delayptr_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* delay_n_fetch */ + + +void delay_toss_fetch(susp, snd_list) + register delay_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void delay_mark(delay_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void delay_free(delay_susp_type susp) +{ +free(susp->delaybuf); sound_unref(susp->input); + ffree_generic(susp, sizeof(delay_susp_node), "delay_free"); +} + + +void delay_print_tree(delay_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_delay(sound_type input, time_type delay, double feedback) +{ + register delay_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, delay_susp_node, "snd_make_delay"); + susp->feedback = feedback; + susp->delaylen = max(1, round(input->sr * delay)); + susp->delaybuf = (sample_type *) calloc (susp->delaylen, sizeof(sample_type)); + susp->delayptr = susp->delaybuf; + susp->endptr = susp->delaybuf + susp->delaylen; + susp->susp.fetch = delay_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = delay_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = delay_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = delay_mark; + susp->susp.print_tree = delay_print_tree; + susp->susp.name = "delay"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_delay(sound_type input, time_type delay, double feedback) +{ + sound_type input_copy = sound_copy(input); + return snd_make_delay(input_copy, delay, feedback); +} diff --git a/tran/delaycc.h b/tran/delaycc.h new file mode 100644 index 0000000..c8ced3f --- /dev/null +++ b/tran/delaycc.h @@ -0,0 +1,3 @@ +sound_type snd_make_delay(sound_type input, time_type delay, double feedback); +sound_type snd_delay(sound_type input, time_type delay, double feedback); + /* LISP: (snd-delay SOUND ANYNUM ANYNUM) */ diff --git a/tran/delaycv.alg b/tran/delaycv.alg new file mode 100644 index 0000000..5823dbd --- /dev/null +++ b/tran/delaycv.alg @@ -0,0 +1,19 @@ +(DELAYCV-ALG +(NAME "delaycv") +(ARGUMENTS ("sound_type" "s") ("time_type" "delay") ("sound_type" "feedback")) +(START (MAX s feedback)) +(STATE ("long" "delaylen" "round(s->sr * delay)") + ("sample_type *" "delaybuf" + "(sample_type *) calloc (sizeof(double), susp->delaylen)") + ("sample_type *" "delayptr" "susp->delaybuf") + ("sample_type *" "endptr" "susp->delaybuf + susp->delaylen")) +(CONSTANT "delaylen" "delaybuf") +(NOT-REGISTER delaybuf) +(LINEAR s) +(TERMINATE (MIN s)) +(INNER-LOOP "output = *delayptr; + *delayptr = *delayptr * feedback + s; + if (++delayptr >= endptr) delayptr = susp->delaybuf;") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/delaycv.c b/tran/delaycv.c new file mode 100644 index 0000000..984e88d --- /dev/null +++ b/tran/delaycv.c @@ -0,0 +1,300 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "delaycv.h" + +void delaycv_free(); + + +typedef struct delaycv_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type s; + long s_cnt; + sample_block_values_type s_ptr; + sound_type feedback; + long feedback_cnt; + sample_block_values_type feedback_ptr; + + long delaylen; + sample_type *delaybuf; + sample_type *delayptr; + sample_type *endptr; +} delaycv_susp_node, *delaycv_susp_type; + + +void delaycv_nn_fetch(register delaycv_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 * delayptr_reg; + register sample_type * endptr_reg; + register sample_block_values_type feedback_ptr_reg; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "delaycv_nn_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_samples(s, s_ptr, s_cnt); + togo = min(togo, susp->s_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = *delayptr_reg; + *delayptr_reg = *delayptr_reg * *feedback_ptr_reg++ + *s_ptr_reg++; + if (++delayptr_reg >= endptr_reg) delayptr_reg = susp->delaybuf;; + } while (--n); /* inner loop */ + + susp->delayptr = delayptr_reg; + susp->endptr = endptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using s_ptr_reg is a bad idea on RS/6000: */ + susp->s_ptr += togo; + out_ptr += togo; + susp_took(s_cnt, togo); + susp_took(feedback_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; + } +} /* delaycv_nn_fetch */ + + +void delaycv_ns_fetch(register delaycv_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 * delayptr_reg; + register sample_type * endptr_reg; + register sample_type feedback_scale_reg = susp->feedback->scale; + register sample_block_values_type feedback_ptr_reg; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "delaycv_ns_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_samples(s, s_ptr, s_cnt); + togo = min(togo, susp->s_cnt); + + /* don't run past the feedback input sample block: */ + susp_check_samples(feedback, feedback_ptr, feedback_cnt); + togo = min(togo, susp->feedback_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; + delayptr_reg = susp->delayptr; + endptr_reg = susp->endptr; + feedback_ptr_reg = susp->feedback_ptr; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = *delayptr_reg; + *delayptr_reg = *delayptr_reg * (feedback_scale_reg * *feedback_ptr_reg++) + *s_ptr_reg++; + if (++delayptr_reg >= endptr_reg) delayptr_reg = susp->delaybuf;; + } while (--n); /* inner loop */ + + susp->delayptr = delayptr_reg; + susp->endptr = endptr_reg; + /* using feedback_ptr_reg is a bad idea on RS/6000: */ + susp->feedback_ptr += togo; + /* using s_ptr_reg is a bad idea on RS/6000: */ + susp->s_ptr += togo; + out_ptr += togo; + susp_took(s_cnt, togo); + susp_took(feedback_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; + } +} /* delaycv_ns_fetch */ + + +void delaycv_toss_fetch(susp, snd_list) + register delaycv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while ((round((final_time - susp->s->t0) * susp->s->sr)) >= + susp->s->current) + susp_get_samples(s, s_ptr, s_cnt); + /* fetch samples from feedback up to final_time for this block of zeros */ + while ((round((final_time - susp->feedback->t0) * susp->feedback->sr)) >= + susp->feedback->current) + susp_get_samples(feedback, feedback_ptr, feedback_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + 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); + n = round((final_time - susp->feedback->t0) * susp->feedback->sr - + (susp->feedback->current - susp->feedback_cnt)); + susp->feedback_ptr += n; + susp_took(feedback_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void delaycv_mark(delaycv_susp_type susp) +{ + sound_xlmark(susp->s); + sound_xlmark(susp->feedback); +} + + +void delaycv_free(delaycv_susp_type susp) +{ +free(susp->delaybuf); sound_unref(susp->s); + sound_unref(susp->feedback); + ffree_generic(susp, sizeof(delaycv_susp_node), "delaycv_free"); +} + + +void delaycv_print_tree(delaycv_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); + + indent(n); + stdputstr("feedback:"); + sound_print_tree_1(susp->feedback, n); +} + + +sound_type snd_make_delaycv(sound_type s, time_type delay, sound_type feedback) +{ + register delaycv_susp_type susp; + rate_type sr = max(s->sr, feedback->sr); + time_type t0 = max(s->t0, feedback->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (S) */ + scale_factor *= s->scale; + s->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (s->sr < sr) { s->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, delaycv_susp_node, "snd_make_delaycv"); + susp->delaylen = round(s->sr * delay); + susp->delaybuf = (sample_type *) calloc (sizeof(double), susp->delaylen); + susp->delayptr = susp->delaybuf; + susp->endptr = susp->delaybuf + susp->delaylen; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s, sr); + interp_desc = (interp_desc << 2) + interp_style(feedback, sr); + switch (interp_desc) { + case INTERP_nn: susp->susp.fetch = delaycv_nn_fetch; break; + case INTERP_ns: susp->susp.fetch = delaycv_ns_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s->t0) sound_prepend_zeros(s, t0); + if (t0 < feedback->t0) sound_prepend_zeros(feedback, t0); + /* minimum start time over all inputs: */ + t0_min = min(s->t0, min(feedback->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 = delaycv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = delaycv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = delaycv_mark; + susp->susp.print_tree = delaycv_print_tree; + susp->susp.name = "delaycv"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->s = s; + susp->s_cnt = 0; + susp->feedback = feedback; + susp->feedback_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_delaycv(sound_type s, time_type delay, sound_type feedback) +{ + sound_type s_copy = sound_copy(s); + sound_type feedback_copy = sound_copy(feedback); + return snd_make_delaycv(s_copy, delay, feedback_copy); +} diff --git a/tran/delaycv.h b/tran/delaycv.h new file mode 100644 index 0000000..5c6e3d0 --- /dev/null +++ b/tran/delaycv.h @@ -0,0 +1,3 @@ +sound_type snd_make_delaycv(sound_type s, time_type delay, sound_type feedback); +sound_type snd_delaycv(sound_type s, time_type delay, sound_type feedback); + /* LISP: (snd-delaycv SOUND ANYNUM SOUND) */ diff --git a/tran/downproto.alg b/tran/downproto.alg new file mode 100644 index 0000000..98680ba --- /dev/null +++ b/tran/downproto.alg @@ -0,0 +1,18 @@ +(DOWNSAMPLE-PROTO-ALG + (NAME "down") + (ARGUMENTS ("rate_type" "sr") ("sound_type" "s")) + (SAMPLE-RATE "sr") + (START (MIN s)) + (INLINE-INTERPOLATION T) + (STATE ) + (INNER-LOOP "output = s") + (TERMINATE (MIN s)) + (LOGICAL-STOP (MIN s)) + (TYPE-CHECK +" if (s->sr < sr) { + sound_unref(s); + xlfail(\"snd-down: output sample rate must be lower than input\"); + } +") +) + diff --git a/tran/eqbandv.alg b/tran/eqbandv.alg new file mode 100644 index 0000000..1837f43 --- /dev/null +++ b/tran/eqbandv.alg @@ -0,0 +1,56 @@ +; general order-2 IIR filter. +; a0 is assumed to be unity. +; for a1 and a2, our sign convention is opposite to Matlab's. + +(EQBANDVVV-ALG +(NAME "eqbandvvv") +(ARGUMENTS ("sound_type" "s1") ("sound_type" "hz")) +;; ("sound_type" "gain") ("sound_type" "width") ) +(START (MIN s1 hz)) ;; gain width)) +(TERMINATE (MIN s1 hz )) ;; gain width)) +(LOGICAL-STOP (MIN s1 hz)) ;; gain width)) +(SAMPLE-RATE (MAX s1)) +(INTERNAL-SCALING s1) +(INLINE-INTERPOLATION T) +(ALWAYS-SCALE hz) +(STEP-FUNCTION hz gain width) +(STATE ("double" "scale1" "s1->scale") + ("double" "w1" "0.0") + ("double" "sw" "0.0") + ("double" "cw" "0.0") + ("double" "J" "0.0") + ("double" "g" "0.0") + ("double" "b0" "0.0") + ("double" "b1" "0.0") + ("double" "b2" "0.0") + ("double" "a0" "0.0") + ("double" "a1" "0.0") + ("double" "a2" "0.0")) +(DEPENDS ("w1" "hz" "PI2 * hz / s1->sr") + ("sw" "hz" "sin(w1)") + ("cw" "hz" "cos(w1)") + ("b1" "hz" "-2.0 * cw") + ("a1" "hz" "-b1") + ;; ("J" "gain" "sqrt(gain)") + ;; ("recompute" "width" "true") + ("recompute" "hz" "true") + ;; ("recompute" "gain" "true") +) +;; (JOINT-DEPENDENCY (("width" "hz") +;;"if (recompute) {" +;;" recompute = false;" +;;" g = sw * sinh(log_of_2_over_2 * width * w1 / sw);" +;;" b0 = 1.0 + g * J;" +;;" b2 = 1.0 - g * J;" +;;" a0 = 1.0 + g / J;" +;;" a2 = g / J - 1.0;" +;;"}")) +(FORCE-INTO-REGISTER recompute) +(STEP-FUNCTION hz) ;; gain width) +(CONSTANT "w1" "sw" "cw" "J" "g" "b0" "b1" "b2" "b3" "a0" "a1" "a2") +(INNER-LOOP-LOCALS "double z0;") +(INNER-LOOP " z0 = s + a1*z1 + a2*z2; + output = (sample_type) (z0*b0 + z1*b1 + z2*b2); + z2 = z1; z1 = z0;") +) + diff --git a/tran/eqbandvvv.alg b/tran/eqbandvvv.alg new file mode 100644 index 0000000..c2a14a4 --- /dev/null +++ b/tran/eqbandvvv.alg @@ -0,0 +1,64 @@ +; general order-2 IIR filter. +; a0 is assumed to be unity. +; for a1 and a2, our sign convention is opposite to Matlab's. + +(EQBANDVVV-ALG +(NAME "eqbandvvv") +(ARGUMENTS ("sound_type" "input") ("sound_type" "hz") + ("sound_type" "gain") ("sound_type" "width") ) +(SUPPORT-FUNCTIONS "#define log_of_2_over_2 0.3465735902799726547086\n") +(START (MIN input hz gain width)) +(TERMINATE (MIN input hz gain width)) +(LOGICAL-STOP (MIN input hz gain width)) +(SAMPLE-RATE (MAX input)) +;;(INTERNAL-SCALING input hz gain width) +(INLINE-INTERPOLATION T) +(MATCHED-SAMPLE-RATE hz gain width) +(ALWAYS-SCALE input hz gain width) +(STEP-FUNCTION hz gain width) +(STATE ("double" "inp_scale" "input->scale") + ("double" "w1" "0.0") + ("double" "sw" "0.0") + ("double" "cw" "0.0") + ("double" "J" "0.0") + ("double" "gg" "0.0") + ("double" "b0" "0.0") + ("double" "b1" "0.0") + ("double" "b2" "0.0") + ("double" "a0" "0.0") + ("double" "a1" "0.0") + ("double" "a2" "0.0") + ("double" "z1" "0.0") + ("double" "z2" "0.0") + ("boolean" "recompute" "false") + ("double" "inp_period" "1.0 / input->sr")) +(DEPENDS ("w1" "hz" "PI2 * hz * inp_period") + ("sw" "hz" "sin(w1)") + ("cw" "hz" "cos(w1)") + ("b1" "hz" "-2.0 * cw") + ("a1" "hz" "-b1") + ("J" "gain" "sqrt(gain)") + ("recompute" "width" "true") + ("recompute" "hz" "true") + ("recompute" "gain" "true") +) +(JOINT-DEPENDENCY (("width" "hz") +"if (recompute) {" +" /* a0 = 1.0 + gg / J; */" +" double a_0_recip = J / (J + gg);" +" recompute = false;" +" gg = sw * sinh(log_of_2_over_2 * width * w1 / sw);" +" b0 = (1.0 + gg * J) * a_0_recip;" +" b1 *= a_0_recip;" +" b2 = (1.0 - gg * J) * a_0_recip;" +" a1 *= a_0_recip;" +" a2 = (gg / J - 1.0) * a_0_recip;" +"}")) +(FORCE-INTO-REGISTER recompute inp_period cw) +(CONSTANT "w1" "sw" "cw" "J" "gg" "b0" "b1" "b2" "b3" "a0" "a1" "a2" "inp_period") +(INNER-LOOP-LOCALS " double z0;\n") +(INNER-LOOP " z0 = input + a1*z1 + a2*z2; + output = (sample_type) (z0*b0 + z1*b1 + z2*b2); + z2 = z1; z1 = z0;") +) + diff --git a/tran/eqbandvvv.c b/tran/eqbandvvv.c new file mode 100644 index 0000000..1c5bcb5 --- /dev/null +++ b/tran/eqbandvvv.c @@ -0,0 +1,868 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "eqbandvvv.h" + +void eqbandvvv_free(); + + +typedef struct eqbandvvv_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + sound_type hz; + long hz_cnt; + sample_block_values_type hz_ptr; + + /* support for interpolation of hz */ + sample_type hz_x1_sample; + double hz_pHaSe; + double hz_pHaSe_iNcR; + + /* support for ramp between samples of hz */ + double output_per_hz; + long hz_n; + sound_type gain; + long gain_cnt; + sample_block_values_type gain_ptr; + + /* support for interpolation of gain */ + sample_type gain_x1_sample; + double gain_pHaSe; + double gain_pHaSe_iNcR; + + /* support for ramp between samples of gain */ + double output_per_gain; + long gain_n; + sound_type width; + long width_cnt; + sample_block_values_type width_ptr; + + /* support for interpolation of width */ + sample_type width_x1_sample; + double width_pHaSe; + double width_pHaSe_iNcR; + + /* support for ramp between samples of width */ + double output_per_width; + long width_n; + + double inp_scale; + double w1; + double sw; + double cw; + double J; + double gg; + double b0; + double b1; + double b2; + double a0; + double a1; + double a2; + double z1; + double z2; + boolean recompute; + double inp_period; +} eqbandvvv_susp_node, *eqbandvvv_susp_type; + +#define log_of_2_over_2 0.3465735902799726547086 + + +void eqbandvvv_ssss_fetch(register eqbandvvv_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 double w1_reg; + register double sw_reg; + register double cw_reg; + register double J_reg; + register double gg_reg; + register double b0_reg; + register double b1_reg; + register double b2_reg; + register double a0_reg; + register double a1_reg; + register double a2_reg; + register double z1_reg; + register double z2_reg; + register boolean recompute_reg; + register double inp_period_reg; + register sample_type width_scale_reg = susp->width->scale; + register sample_block_values_type width_ptr_reg; + register sample_type gain_scale_reg = susp->gain->scale; + register sample_block_values_type gain_ptr_reg; + register sample_type hz_scale_reg = susp->hz->scale; + register sample_block_values_type hz_ptr_reg; + register sample_type input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "eqbandvvv_ssss_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 input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* don't run past the hz input sample block: */ + susp_check_term_log_samples(hz, hz_ptr, hz_cnt); + togo = min(togo, susp->hz_cnt); + + /* don't run past the gain input sample block: */ + susp_check_term_log_samples(gain, gain_ptr, gain_cnt); + togo = min(togo, susp->gain_cnt); + + /* don't run past the width input sample block: */ + susp_check_term_log_samples(width, width_ptr, width_cnt); + togo = min(togo, susp->width_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; + w1_reg = susp->w1; + sw_reg = susp->sw; + cw_reg = susp->cw; + J_reg = susp->J; + gg_reg = susp->gg; + b0_reg = susp->b0; + b1_reg = susp->b1; + b2_reg = susp->b2; + a0_reg = susp->a0; + a1_reg = susp->a1; + a2_reg = susp->a2; + z1_reg = susp->z1; + z2_reg = susp->z2; + recompute_reg = susp->recompute; + inp_period_reg = susp->inp_period; + width_ptr_reg = susp->width_ptr; + gain_ptr_reg = susp->gain_ptr; + hz_ptr_reg = susp->hz_ptr; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double z0; + w1_reg = PI2 * (hz_scale_reg * *hz_ptr_reg++) * inp_period_reg; + sw_reg = sin(w1_reg); + cw_reg = cos(w1_reg); + b1_reg = -2.0 * cw_reg; + a1_reg = -b1_reg; + J_reg = sqrt((gain_scale_reg * *gain_ptr_reg++)); + recompute_reg = true; + recompute_reg = true; + recompute_reg = true; + if (recompute_reg) { + /* a0_reg = 1.0 + gg_reg / J_reg; */ + double a_0_recip = J_reg / (J_reg + gg_reg); + recompute_reg = false; + gg_reg = sw_reg * sinh(log_of_2_over_2 * (width_scale_reg * *width_ptr_reg++) * w1_reg / sw_reg); + b0_reg = (1.0 + gg_reg * J_reg) * a_0_recip; + b1_reg *= a_0_recip; + b2_reg = (1.0 - gg_reg * J_reg) * a_0_recip; + a1_reg *= a_0_recip; + a2_reg = (gg_reg / J_reg - 1.0) * a_0_recip; + } + z0 = (input_scale_reg * *input_ptr_reg++) + a1_reg*z1_reg + a2_reg*z2_reg; + *out_ptr_reg++ = (sample_type) (z0*b0_reg + z1_reg*b1_reg + z2_reg*b2_reg); + z2_reg = z1_reg; z1_reg = z0;; + } while (--n); /* inner loop */ + + susp->z1 = z1_reg; + susp->z2 = z2_reg; + susp->recompute = recompute_reg; + /* using width_ptr_reg is a bad idea on RS/6000: */ + susp->width_ptr += togo; + /* using gain_ptr_reg is a bad idea on RS/6000: */ + susp->gain_ptr += togo; + /* using hz_ptr_reg is a bad idea on RS/6000: */ + susp->hz_ptr += togo; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp_took(hz_cnt, togo); + susp_took(gain_cnt, togo); + susp_took(width_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; + } +} /* eqbandvvv_ssss_fetch */ + + +void eqbandvvv_siii_fetch(register eqbandvvv_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 double w1_reg; + register double sw_reg; + register double cw_reg; + register double J_reg; + register double gg_reg; + register double b0_reg; + register double b1_reg; + register double b2_reg; + register double a0_reg; + register double a1_reg; + register double a2_reg; + register double z1_reg; + register double z2_reg; + register boolean recompute_reg; + register double inp_period_reg; + register double width_pHaSe_iNcR_rEg = susp->width_pHaSe_iNcR; + register double width_pHaSe_ReG; + register sample_type width_x1_sample_reg; + register double gain_pHaSe_iNcR_rEg = susp->gain_pHaSe_iNcR; + register double gain_pHaSe_ReG; + register sample_type gain_x1_sample_reg; + register double hz_pHaSe_iNcR_rEg = susp->hz_pHaSe_iNcR; + register double hz_pHaSe_ReG; + register sample_type hz_x1_sample_reg; + register sample_type input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "eqbandvvv_siii_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(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->w1 = PI2 * susp->hz_x1_sample * susp->inp_period; + susp->sw = sin(susp->w1); + susp->cw = cos(susp->w1); + susp->b1 = -2.0 * susp->cw; + susp->a1 = -susp->b1; + susp->recompute = true; + susp_check_term_log_samples(gain, gain_ptr, gain_cnt); + susp->gain_x1_sample = susp_fetch_sample(gain, gain_ptr, gain_cnt); + susp->J = sqrt(susp->gain_x1_sample); + susp->recompute = true; + susp_check_term_log_samples(width, width_ptr, width_cnt); + susp->width_x1_sample = susp_fetch_sample(width, width_ptr, width_cnt); + susp->recompute = true; + } + + 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 input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + w1_reg = susp->w1; + sw_reg = susp->sw; + cw_reg = susp->cw; + J_reg = susp->J; + gg_reg = susp->gg; + b0_reg = susp->b0; + b1_reg = susp->b1; + b2_reg = susp->b2; + a0_reg = susp->a0; + a1_reg = susp->a1; + a2_reg = susp->a2; + z1_reg = susp->z1; + z2_reg = susp->z2; + recompute_reg = susp->recompute; + inp_period_reg = susp->inp_period; + width_pHaSe_ReG = susp->width_pHaSe; + width_x1_sample_reg = susp->width_x1_sample; + gain_pHaSe_ReG = susp->gain_pHaSe; + gain_x1_sample_reg = susp->gain_x1_sample; + hz_pHaSe_ReG = susp->hz_pHaSe; + hz_x1_sample_reg = susp->hz_x1_sample; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double z0; + if (hz_pHaSe_ReG >= 1.0) { +/* fixup-depends hz */ + /* pick up next sample as hz_x1_sample: */ + susp->hz_ptr++; + susp_took(hz_cnt, 1); + hz_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(hz, hz_ptr, hz_cnt, hz_x1_sample_reg); + hz_x1_sample_reg = susp_current_sample(hz, hz_ptr); + w1_reg = susp->w1 = PI2 * hz_x1_sample_reg * inp_period_reg; + sw_reg = susp->sw = sin(w1_reg); + cw_reg = susp->cw = cos(w1_reg); + b1_reg = susp->b1 = -2.0 * cw_reg; + a1_reg = susp->a1 = -b1_reg; + recompute_reg = susp->recompute = true; + } + if (gain_pHaSe_ReG >= 1.0) { +/* fixup-depends gain */ + /* pick up next sample as gain_x1_sample: */ + susp->gain_ptr++; + susp_took(gain_cnt, 1); + gain_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(gain, gain_ptr, gain_cnt, gain_x1_sample_reg); + gain_x1_sample_reg = susp_current_sample(gain, gain_ptr); + J_reg = susp->J = sqrt(gain_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + if (width_pHaSe_ReG >= 1.0) { +/* fixup-depends width */ + /* pick up next sample as width_x1_sample: */ + susp->width_ptr++; + susp_took(width_cnt, 1); + width_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(width, width_ptr, width_cnt, width_x1_sample_reg); + width_x1_sample_reg = susp_current_sample(width, width_ptr); + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + /* a0_reg = 1.0 + gg_reg / J_reg; */ + double a_0_recip = J_reg / (J_reg + gg_reg); + recompute_reg = false; + gg_reg = sw_reg * sinh(log_of_2_over_2 * width_x1_sample_reg * w1_reg / sw_reg); + b0_reg = (1.0 + gg_reg * J_reg) * a_0_recip; + b1_reg *= a_0_recip; + b2_reg = (1.0 - gg_reg * J_reg) * a_0_recip; + a1_reg *= a_0_recip; + a2_reg = (gg_reg / J_reg - 1.0) * a_0_recip; + } + z0 = (input_scale_reg * *input_ptr_reg++) + a1_reg*z1_reg + a2_reg*z2_reg; + *out_ptr_reg++ = (sample_type) (z0*b0_reg + z1_reg*b1_reg + z2_reg*b2_reg); + z2_reg = z1_reg; z1_reg = z0;; + hz_pHaSe_ReG += hz_pHaSe_iNcR_rEg; + gain_pHaSe_ReG += gain_pHaSe_iNcR_rEg; + width_pHaSe_ReG += width_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->z1 = z1_reg; + susp->z2 = z2_reg; + susp->recompute = recompute_reg; + susp->width_pHaSe = width_pHaSe_ReG; + susp->width_x1_sample = width_x1_sample_reg; + susp->gain_pHaSe = gain_pHaSe_ReG; + susp->gain_x1_sample = gain_x1_sample_reg; + susp->hz_pHaSe = hz_pHaSe_ReG; + susp->hz_x1_sample = hz_x1_sample_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* eqbandvvv_siii_fetch */ + + +void eqbandvvv_srrr_fetch(register eqbandvvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz_val; + sample_type gain_val; + sample_type width_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double cw_reg; + register double b0_reg; + register double b1_reg; + register double b2_reg; + register double a1_reg; + register double a2_reg; + register double z1_reg; + register double z2_reg; + register boolean recompute_reg; + register double inp_period_reg; + register sample_type input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "eqbandvvv_srrr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz_pHaSe = 1.0; + susp->gain_pHaSe = 1.0; + susp->width_pHaSe = 1.0; + } + + susp_check_term_log_samples(hz, hz_ptr, hz_cnt); + + susp_check_term_log_samples(gain, gain_ptr, gain_cnt); + + susp_check_term_log_samples(width, width_ptr, width_cnt); + + 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 input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_cnt); + + /* grab next hz_x1_sample when phase goes past 1.0; */ + /* use hz_n (computed below) to avoid roundoff errors: */ + if (susp->hz_n <= 0) { + susp_check_term_log_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->hz_pHaSe -= 1.0; + /* hz_n gets number of samples before phase exceeds 1.0: */ + susp->hz_n = (long) ((1.0 - susp->hz_pHaSe) * + susp->output_per_hz); + susp->w1 = PI2 * susp->hz_x1_sample * susp->inp_period; + susp->sw = sin(susp->w1); + susp->cw = cos(susp->w1); + susp->b1 = -2.0 * susp->cw; + susp->a1 = -susp->b1; + susp->recompute = true; + } + togo = min(togo, susp->hz_n); + hz_val = susp->hz_x1_sample; + /* grab next gain_x1_sample when phase goes past 1.0; */ + /* use gain_n (computed below) to avoid roundoff errors: */ + if (susp->gain_n <= 0) { + susp_check_term_log_samples(gain, gain_ptr, gain_cnt); + susp->gain_x1_sample = susp_fetch_sample(gain, gain_ptr, gain_cnt); + susp->gain_pHaSe -= 1.0; + /* gain_n gets number of samples before phase exceeds 1.0: */ + susp->gain_n = (long) ((1.0 - susp->gain_pHaSe) * + susp->output_per_gain); + susp->J = sqrt(susp->gain_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->gain_n); + gain_val = susp->gain_x1_sample; + /* grab next width_x1_sample when phase goes past 1.0; */ + /* use width_n (computed below) to avoid roundoff errors: */ + if (susp->width_n <= 0) { + susp_check_term_log_samples(width, width_ptr, width_cnt); + susp->width_x1_sample = susp_fetch_sample(width, width_ptr, width_cnt); + susp->width_pHaSe -= 1.0; + /* width_n gets number of samples before phase exceeds 1.0: */ + susp->width_n = (long) ((1.0 - susp->width_pHaSe) * + susp->output_per_width); + susp->recompute = true; + } + togo = min(togo, susp->width_n); + width_val = susp->width_x1_sample; + if (susp->recompute) { + /* susp->a0 = 1.0 + susp->gg / susp->J; */ + double a_0_recip = susp->J / (susp->J + susp->gg); + susp->recompute = false; + susp->gg = susp->sw * sinh(log_of_2_over_2 * width_val * susp->w1 / susp->sw); + susp->b0 = (1.0 + susp->gg * susp->J) * a_0_recip; + susp->b1 *= a_0_recip; + susp->b2 = (1.0 - susp->gg * susp->J) * a_0_recip; + susp->a1 *= a_0_recip; + susp->a2 = (susp->gg / susp->J - 1.0) * a_0_recip; + } + /* 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; + cw_reg = susp->cw; + b0_reg = susp->b0; + b1_reg = susp->b1; + b2_reg = susp->b2; + a1_reg = susp->a1; + a2_reg = susp->a2; + z1_reg = susp->z1; + z2_reg = susp->z2; + recompute_reg = susp->recompute; + inp_period_reg = susp->inp_period; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double z0; + z0 = (input_scale_reg * *input_ptr_reg++) + a1_reg*z1_reg + a2_reg*z2_reg; + *out_ptr_reg++ = (sample_type) (z0*b0_reg + z1_reg*b1_reg + z2_reg*b2_reg); + z2_reg = z1_reg; z1_reg = z0;; + } while (--n); /* inner loop */ + + susp->z1 = z1_reg; + susp->z2 = z2_reg; + susp->recompute = recompute_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_cnt, togo); + susp->hz_pHaSe += togo * susp->hz_pHaSe_iNcR; + susp->hz_n -= togo; + susp->gain_pHaSe += togo * susp->gain_pHaSe_iNcR; + susp->gain_n -= togo; + susp->width_pHaSe += togo * susp->width_pHaSe_iNcR; + susp->width_n -= 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; + } +} /* eqbandvvv_srrr_fetch */ + + +void eqbandvvv_toss_fetch(susp, snd_list) + register eqbandvvv_susp_type susp; + snd_list_type snd_list; +{ + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* fetch samples from hz up to final_time for this block of zeros */ + while ((round((final_time - susp->hz->t0) * susp->hz->sr)) >= + susp->hz->current) + susp_get_samples(hz, hz_ptr, hz_cnt); + /* fetch samples from gain up to final_time for this block of zeros */ + while ((round((final_time - susp->gain->t0) * susp->gain->sr)) >= + susp->gain->current) + susp_get_samples(gain, gain_ptr, gain_cnt); + /* fetch samples from width up to final_time for this block of zeros */ + while ((round((final_time - susp->width->t0) * susp->width->sr)) >= + susp->width->current) + susp_get_samples(width, width_ptr, width_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + n = round((final_time - susp->hz->t0) * susp->hz->sr - + (susp->hz->current - susp->hz_cnt)); + susp->hz_ptr += n; + susp_took(hz_cnt, n); + n = round((final_time - susp->gain->t0) * susp->gain->sr - + (susp->gain->current - susp->gain_cnt)); + susp->gain_ptr += n; + susp_took(gain_cnt, n); + n = round((final_time - susp->width->t0) * susp->width->sr - + (susp->width->current - susp->width_cnt)); + susp->width_ptr += n; + susp_took(width_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void eqbandvvv_mark(eqbandvvv_susp_type susp) +{ + sound_xlmark(susp->input); + sound_xlmark(susp->hz); + sound_xlmark(susp->gain); + sound_xlmark(susp->width); +} + + +void eqbandvvv_free(eqbandvvv_susp_type susp) +{ + sound_unref(susp->input); + sound_unref(susp->hz); + sound_unref(susp->gain); + sound_unref(susp->width); + ffree_generic(susp, sizeof(eqbandvvv_susp_node), "eqbandvvv_free"); +} + + +void eqbandvvv_print_tree(eqbandvvv_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); + + indent(n); + stdputstr("hz:"); + sound_print_tree_1(susp->hz, n); + + indent(n); + stdputstr("gain:"); + sound_print_tree_1(susp->gain, n); + + indent(n); + stdputstr("width:"); + sound_print_tree_1(susp->width, n); +} + + +sound_type snd_make_eqbandvvv(sound_type input, sound_type hz, sound_type gain, sound_type width) +{ + register eqbandvvv_susp_type susp; + rate_type sr = input->sr; + time_type t0 = min(min(min(input->t0, hz->t0), gain->t0), width->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + long lsc; + falloc_generic(susp, eqbandvvv_susp_node, "snd_make_eqbandvvv"); + susp->inp_scale = input->scale; + susp->w1 = 0.0; + susp->sw = 0.0; + susp->cw = 0.0; + susp->J = 0.0; + susp->gg = 0.0; + susp->b0 = 0.0; + susp->b1 = 0.0; + susp->b2 = 0.0; + susp->a0 = 0.0; + susp->a1 = 0.0; + susp->a2 = 0.0; + susp->z1 = 0.0; + susp->z2 = 0.0; + susp->recompute = false; + susp->inp_period = 1.0 / input->sr; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(input, sr); + interp_desc = (interp_desc << 2) + interp_style(hz, sr); + interp_desc = (interp_desc << 2) + interp_style(gain, sr); + interp_desc = (interp_desc << 2) + interp_style(width, sr); + switch (interp_desc) { + case INTERP_nnnn: /* handled below */ + case INTERP_nnns: /* handled below */ + case INTERP_nnsn: /* handled below */ + case INTERP_nnss: /* handled below */ + case INTERP_nsnn: /* handled below */ + case INTERP_nsns: /* handled below */ + case INTERP_nssn: /* handled below */ + case INTERP_nsss: /* handled below */ + case INTERP_snnn: /* handled below */ + case INTERP_snns: /* handled below */ + case INTERP_snsn: /* handled below */ + case INTERP_snss: /* handled below */ + case INTERP_ssnn: /* handled below */ + case INTERP_ssns: /* handled below */ + case INTERP_sssn: /* handled below */ + case INTERP_ssss: susp->susp.fetch = eqbandvvv_ssss_fetch; break; + case INTERP_niii: /* handled below */ + case INTERP_siii: susp->susp.fetch = eqbandvvv_siii_fetch; break; + case INTERP_nrrr: /* handled below */ + case INTERP_srrr: susp->susp.fetch = eqbandvvv_srrr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + if (t0 < hz->t0) sound_prepend_zeros(hz, t0); + if (t0 < gain->t0) sound_prepend_zeros(gain, t0); + if (t0 < width->t0) sound_prepend_zeros(width, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->t0, min(hz->t0, min(gain->t0, min(width->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 = eqbandvvv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = eqbandvvv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = eqbandvvv_mark; + susp->susp.print_tree = eqbandvvv_print_tree; + susp->susp.name = "eqbandvvv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + lsc = logical_stop_cnt_cvt(hz); + if (susp->susp.log_stop_cnt > lsc) + susp->susp.log_stop_cnt = lsc; + lsc = logical_stop_cnt_cvt(gain); + if (susp->susp.log_stop_cnt > lsc) + susp->susp.log_stop_cnt = lsc; + lsc = logical_stop_cnt_cvt(width); + if (susp->susp.log_stop_cnt > lsc) + susp->susp.log_stop_cnt = lsc; + susp->started = false; + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + susp->hz = hz; + susp->hz_cnt = 0; + susp->hz_pHaSe = 0.0; + susp->hz_pHaSe_iNcR = hz->sr / sr; + susp->hz_n = 0; + susp->output_per_hz = sr / hz->sr; + susp->gain = gain; + susp->gain_cnt = 0; + susp->gain_pHaSe = 0.0; + susp->gain_pHaSe_iNcR = gain->sr / sr; + susp->gain_n = 0; + susp->output_per_gain = sr / gain->sr; + susp->width = width; + susp->width_cnt = 0; + susp->width_pHaSe = 0.0; + susp->width_pHaSe_iNcR = width->sr / sr; + susp->width_n = 0; + susp->output_per_width = sr / width->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_eqbandvvv(sound_type input, sound_type hz, sound_type gain, sound_type width) +{ + sound_type input_copy = sound_copy(input); + sound_type hz_copy = sound_copy(hz); + sound_type gain_copy = sound_copy(gain); + sound_type width_copy = sound_copy(width); + return snd_make_eqbandvvv(input_copy, hz_copy, gain_copy, width_copy); +} diff --git a/tran/eqbandvvv.h b/tran/eqbandvvv.h new file mode 100644 index 0000000..a42a44f --- /dev/null +++ b/tran/eqbandvvv.h @@ -0,0 +1,3 @@ +sound_type snd_make_eqbandvvv(sound_type input, sound_type hz, sound_type gain, sound_type width); +sound_type snd_eqbandvvv(sound_type input, sound_type hz, sound_type gain, sound_type width); + /* LISP: (snd-eqbandvvv SOUND SOUND SOUND SOUND) */ diff --git a/tran/exp.alg b/tran/exp.alg new file mode 100644 index 0000000..e3f706e --- /dev/null +++ b/tran/exp.alg @@ -0,0 +1,9 @@ +(EXP-ALG + (NAME "exp") + (ARGUMENTS ("sound_type" "in")) + (ALWAYS-SCALE in) + (START (MIN in)) + (INNER-LOOP "output = (sample_type) exp(in)") + (TERMINATE (MIN in)) + (LOGICAL-STOP (MIN in)) +) diff --git a/tran/exp.c b/tran/exp.c new file mode 100644 index 0000000..1cae60e --- /dev/null +++ b/tran/exp.c @@ -0,0 +1,198 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "exp.h" + +void exp_free(); + + +typedef struct exp_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type in; + long in_cnt; + sample_block_values_type in_ptr; +} exp_susp_node, *exp_susp_type; + + +void exp_s_fetch(register exp_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 in_scale_reg = susp->in->scale; + register sample_block_values_type in_ptr_reg; + falloc_sample_block(out, "exp_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 in input sample block: */ + susp_check_term_log_samples(in, in_ptr, in_cnt); + togo = min(togo, susp->in_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; + in_ptr_reg = susp->in_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) exp((in_scale_reg * *in_ptr_reg++)); + } while (--n); /* inner loop */ + + /* using in_ptr_reg is a bad idea on RS/6000: */ + susp->in_ptr += togo; + out_ptr += togo; + susp_took(in_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; + } +} /* exp_s_fetch */ + + +void exp_toss_fetch(susp, snd_list) + register exp_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from in up to final_time for this block of zeros */ + while ((round((final_time - susp->in->t0) * susp->in->sr)) >= + susp->in->current) + susp_get_samples(in, in_ptr, in_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->in->t0) * susp->in->sr - + (susp->in->current - susp->in_cnt)); + susp->in_ptr += n; + susp_took(in_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void exp_mark(exp_susp_type susp) +{ + sound_xlmark(susp->in); +} + + +void exp_free(exp_susp_type susp) +{ + sound_unref(susp->in); + ffree_generic(susp, sizeof(exp_susp_node), "exp_free"); +} + + +void exp_print_tree(exp_susp_type susp, int n) +{ + indent(n); + stdputstr("in:"); + sound_print_tree_1(susp->in, n); +} + + +sound_type snd_make_exp(sound_type in) +{ + register exp_susp_type susp; + rate_type sr = in->sr; + time_type t0 = in->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, exp_susp_node, "snd_make_exp"); + susp->susp.fetch = exp_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < in->t0) sound_prepend_zeros(in, t0); + /* minimum start time over all inputs: */ + t0_min = min(in->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 = exp_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = exp_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = exp_mark; + susp->susp.print_tree = exp_print_tree; + susp->susp.name = "exp"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(in); + susp->susp.current = 0; + susp->in = in; + susp->in_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_exp(sound_type in) +{ + sound_type in_copy = sound_copy(in); + return snd_make_exp(in_copy); +} diff --git a/tran/exp.h b/tran/exp.h new file mode 100644 index 0000000..7e16a13 --- /dev/null +++ b/tran/exp.h @@ -0,0 +1,3 @@ +sound_type snd_make_exp(sound_type in); +sound_type snd_exp(sound_type in); + /* LISP: (snd-exp SOUND) */ diff --git a/tran/exprel.alg b/tran/exprel.alg new file mode 100644 index 0000000..2e29a4b --- /dev/null +++ b/tran/exprel.alg @@ -0,0 +1,50 @@ +;; this is the beginnings of a new function that just passes input to output until +;; a given "release time" at which point the output decays exponentially to zero. +;; this is hard to do in Nyquist without a new primitive because the amplitude of +;; the exponential decay depends on the value of the input at some given time. +;; (Yes, you can evaluate that point, but then you have to compute all the samples, +;; and they will be held in memory, which might not be a good thing.) + +(EXPREL-ALG +(NAME "exprel") +(ARGUMENTS ("sound_type" "signal") ("time_type" "release_time") ("double" "fall_time")) +(SUPPORT-FUNCTIONS "#define ST_HOLD 0 +#define ST_FALL 1 +#define ST_FALL_UNTIL 2 +#define ST_OFF 3 +#define ST_OFF_UNTIL 4 +#define ST_RISE 5 + +/* Overview: +This operation passes its input to its output until the release time. Then, it takes +the last sample output as a starting point for an exponential decay, with a duration +of falltime. +*/ + +") +(STATE + ("long" "release_time" "signal->sr * release_time + 0.5") + ("double" "fall_time" "signal->sr * falltime + 0.5") + ("sample_type" "value" "0") + ("bool" "falling" "0")) +(TERMINATE (MIN signal)) +(LOGICAL-STOP "release_time") +(LINEAR signal) +(INNER-LOOP "{ + sample_type result; + if (falling) { + value = value * decay; + result = value; + } else { + result = signal; + if (release_time <= susp->susp.current + cnt + togo - n) { + value = result; + falling = 1; + } + } + output = (sample_type) value; + }") +) + +need to do logical stop time and termination time + diff --git a/tran/fmfb.alg b/tran/fmfb.alg new file mode 100644 index 0000000..801da05 --- /dev/null +++ b/tran/fmfb.alg @@ -0,0 +1,26 @@ +(FMFB-ALG + (NAME "fmfb") + (ARGUMENTS ("time_type" "t0")("double" "hz") ("rate_type" "sr")("double" "index") ("time_type" "d")) + (TERMINATE (AFTER "d")) + (STATE ("double" "yy" "0.0") + ("double" "sin_y" "0.0") + ("double" "xx" "0.0") + ("double" "x_incr" + "hz * SINE_TABLE_LEN / sr") + ("double" "index" "index * SINE_TABLE_LEN / PI2")) + (INNER-LOOP "xx += x_incr; + if (xx > SINE_TABLE_LEN) xx -= SINE_TABLE_LEN; + /* xx incremented and index scaled to table index, and + sin_y is a signal (-1 to +1) */ + yy = xx + index * sin_y; + /* so yy is a table index */ + while (yy > SINE_TABLE_LEN) yy -= SINE_TABLE_LEN; + while (yy < 0) yy += SINE_TABLE_LEN; + sin_y = sine_table[(int) yy]; /* truncation gets valid index */ + /* sin_y is now a signal not ready for table lookup */ + output = sin_y;") + (CONSTANT "x_incr") + (SAMPLE-RATE "sr") + (SUPPORT-HEADER "#include \"sine.h\" /* sine_table and SINE_TABLE_LEN */ +") +) diff --git a/tran/fmfb.c b/tran/fmfb.c new file mode 100644 index 0000000..28ce95e --- /dev/null +++ b/tran/fmfb.c @@ -0,0 +1,139 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "fmfb.h" + +void fmfb_free(); + + +typedef struct fmfb_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + double yy; + double sin_y; + double xx; + double x_incr; + double index; +} fmfb_susp_node, *fmfb_susp_type; + + +void fmfb__fetch(register fmfb_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 double yy_reg; + register double sin_y_reg; + register double xx_reg; + register double x_incr_reg; + register double index_reg; + falloc_sample_block(out, "fmfb__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; + } + + n = togo; + yy_reg = susp->yy; + sin_y_reg = susp->sin_y; + xx_reg = susp->xx; + x_incr_reg = susp->x_incr; + index_reg = susp->index; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +xx_reg += x_incr_reg; + if (xx_reg > SINE_TABLE_LEN) xx_reg -= SINE_TABLE_LEN; + /* xx_reg incremented and index_reg scaled to table index_reg, and + sin_y_reg is a signal (-1 to +1) */ + yy_reg = xx_reg + index_reg * sin_y_reg; + /* so yy_reg is a table index_reg */ + while (yy_reg > SINE_TABLE_LEN) yy_reg -= SINE_TABLE_LEN; + while (yy_reg < 0) yy_reg += SINE_TABLE_LEN; + sin_y_reg = sine_table[(int) yy_reg]; /* truncation gets valid index_reg */ + /* sin_y_reg is now a signal not ready for table lookup */ + *out_ptr_reg++ = sin_y_reg;; + } while (--n); /* inner loop */ + + susp->yy = yy_reg; + susp->sin_y = sin_y_reg; + susp->xx = xx_reg; + susp->index = index_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; + } +} /* fmfb__fetch */ + + +void fmfb_free(fmfb_susp_type susp) +{ + ffree_generic(susp, sizeof(fmfb_susp_node), "fmfb_free"); +} + + +void fmfb_print_tree(fmfb_susp_type susp, int n) +{ +} + + +sound_type snd_make_fmfb(time_type t0, double hz, rate_type sr, double index, time_type d) +{ + register fmfb_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, fmfb_susp_node, "snd_make_fmfb"); + susp->yy = 0.0; + susp->sin_y = 0.0; + susp->xx = 0.0; + susp->x_incr = hz * SINE_TABLE_LEN / sr; + susp->index = index * SINE_TABLE_LEN / PI2; + susp->susp.fetch = fmfb__fetch; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = fmfb_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = fmfb_print_tree; + susp->susp.name = "fmfb"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_fmfb(time_type t0, double hz, rate_type sr, double index, time_type d) +{ + return snd_make_fmfb(t0, hz, sr, index, d); +} diff --git a/tran/fmfb.h b/tran/fmfb.h new file mode 100644 index 0000000..7cd3a59 --- /dev/null +++ b/tran/fmfb.h @@ -0,0 +1,4 @@ +sound_type snd_make_fmfb(time_type t0, double hz, rate_type sr, double index, time_type d); +sound_type snd_fmfb(time_type t0, double hz, rate_type sr, double index, time_type d); + /* LISP: (snd-fmfb ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ +#include "sine.h" /* sine_table and SINE_TABLE_LEN */ diff --git a/tran/fmfbv.alg b/tran/fmfbv.alg new file mode 100644 index 0000000..8034ddb --- /dev/null +++ b/tran/fmfbv.alg @@ -0,0 +1,30 @@ +(FMFBV-ALG + (NAME "fmfbv") + (ARGUMENTS ("time_type" "t0")("double" "hz") ("rate_type" "sr")("sound_type" "index")) + (START (MIN index)) + (TERMINATE (MIN index)) + (LOGICAL-STOP (MIN index)) + (STEP-FUNCTION index) + (INLINE-INTERPOLATION T) + (STATE ("double" "yy" "0.0") + ("double" "sin_y" "0.0") + ("double" "phase" "0.0") + ("double" "ph_incr" "hz * SINE_TABLE_LEN / sr; + index->scale *= SINE_TABLE_LEN / PI2 +")) + (INNER-LOOP "phase += ph_incr; + if (phase > SINE_TABLE_LEN) phase -= SINE_TABLE_LEN; + /* PHASE is incremented and INDEX scaled to table INDEX, and + sin_y is a signal (-1 to +1) */ + yy = phase + index * sin_y; + /* so yy is a table index */ + while (yy > SINE_TABLE_LEN) yy -= SINE_TABLE_LEN; + while (yy < 0) yy += SINE_TABLE_LEN; + sin_y = sine_table[(int) yy]; /* truncation gets valid index */ + /* sin_y is now a signal not ready for table lookup */ + output = sin_y;") + (CONSTANT "ph_incr") + (SAMPLE-RATE "sr") + (SUPPORT-HEADER "#include \"sine.h\" /* sine_table and SINE_TABLE_LEN */ +") +) diff --git a/tran/fmfbv.c b/tran/fmfbv.c new file mode 100644 index 0000000..e843a45 --- /dev/null +++ b/tran/fmfbv.c @@ -0,0 +1,606 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "fmfbv.h" + +void fmfbv_free(); + + +typedef struct fmfbv_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type index; + long index_cnt; + sample_block_values_type index_ptr; + + /* support for interpolation of index */ + sample_type index_x1_sample; + double index_pHaSe; + double index_pHaSe_iNcR; + + /* support for ramp between samples of index */ + double output_per_index; + long index_n; + + double yy; + double sin_y; + double phase; + double ph_incr; +} fmfbv_susp_node, *fmfbv_susp_type; + + +void fmfbv_n_fetch(register fmfbv_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 double yy_reg; + register double sin_y_reg; + register double phase_reg; + register double ph_incr_reg; + register sample_block_values_type index_ptr_reg; + falloc_sample_block(out, "fmfbv_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 index input sample block: */ + susp_check_term_log_samples(index, index_ptr, index_cnt); + togo = min(togo, susp->index_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; + yy_reg = susp->yy; + sin_y_reg = susp->sin_y; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + index_ptr_reg = susp->index_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +phase_reg += ph_incr_reg; + if (phase_reg > SINE_TABLE_LEN) phase_reg -= SINE_TABLE_LEN; + /* PHASE is incremented and INDEX scaled to table INDEX, and + sin_y_reg is a signal (-1 to +1) */ + yy_reg = phase_reg + *index_ptr_reg++ * sin_y_reg; + /* so yy_reg is a table index */ + while (yy_reg > SINE_TABLE_LEN) yy_reg -= SINE_TABLE_LEN; + while (yy_reg < 0) yy_reg += SINE_TABLE_LEN; + sin_y_reg = sine_table[(int) yy_reg]; /* truncation gets valid index */ + /* sin_y_reg is now a signal not ready for table lookup */ + *out_ptr_reg++ = sin_y_reg;; + } while (--n); /* inner loop */ + + susp->yy = yy_reg; + susp->sin_y = sin_y_reg; + susp->phase = phase_reg; + /* using index_ptr_reg is a bad idea on RS/6000: */ + susp->index_ptr += togo; + out_ptr += togo; + susp_took(index_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; + } +} /* fmfbv_n_fetch */ + + +void fmfbv_s_fetch(register fmfbv_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 double yy_reg; + register double sin_y_reg; + register double phase_reg; + register double ph_incr_reg; + register sample_type index_scale_reg = susp->index->scale; + register sample_block_values_type index_ptr_reg; + falloc_sample_block(out, "fmfbv_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 index input sample block: */ + susp_check_term_log_samples(index, index_ptr, index_cnt); + togo = min(togo, susp->index_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; + yy_reg = susp->yy; + sin_y_reg = susp->sin_y; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + index_ptr_reg = susp->index_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +phase_reg += ph_incr_reg; + if (phase_reg > SINE_TABLE_LEN) phase_reg -= SINE_TABLE_LEN; + /* PHASE is incremented and INDEX scaled to table INDEX, and + sin_y_reg is a signal (-1 to +1) */ + yy_reg = phase_reg + (index_scale_reg * *index_ptr_reg++) * sin_y_reg; + /* so yy_reg is a table index */ + while (yy_reg > SINE_TABLE_LEN) yy_reg -= SINE_TABLE_LEN; + while (yy_reg < 0) yy_reg += SINE_TABLE_LEN; + sin_y_reg = sine_table[(int) yy_reg]; /* truncation gets valid index */ + /* sin_y_reg is now a signal not ready for table lookup */ + *out_ptr_reg++ = sin_y_reg;; + } while (--n); /* inner loop */ + + susp->yy = yy_reg; + susp->sin_y = sin_y_reg; + susp->phase = phase_reg; + /* using index_ptr_reg is a bad idea on RS/6000: */ + susp->index_ptr += togo; + out_ptr += togo; + susp_took(index_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; + } +} /* fmfbv_s_fetch */ + + +void fmfbv_i_fetch(register fmfbv_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 double yy_reg; + register double sin_y_reg; + register double phase_reg; + register double ph_incr_reg; + register double index_pHaSe_iNcR_rEg = susp->index_pHaSe_iNcR; + register double index_pHaSe_ReG; + register sample_type index_x1_sample_reg; + falloc_sample_block(out, "fmfbv_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(index, index_ptr, index_cnt); + susp->index_x1_sample = susp_fetch_sample(index, index_ptr, index_cnt); + } + + 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); + /* 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; + yy_reg = susp->yy; + sin_y_reg = susp->sin_y; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + index_pHaSe_ReG = susp->index_pHaSe; + index_x1_sample_reg = susp->index_x1_sample; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (index_pHaSe_ReG >= 1.0) { +/* fixup-depends index */ + /* pick up next sample as index_x1_sample: */ + susp->index_ptr++; + susp_took(index_cnt, 1); + index_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(index, index_ptr, index_cnt, index_x1_sample_reg); + index_x1_sample_reg = susp_current_sample(index, index_ptr); + } +phase_reg += ph_incr_reg; + if (phase_reg > SINE_TABLE_LEN) phase_reg -= SINE_TABLE_LEN; + /* PHASE is incremented and INDEX scaled to table INDEX, and + sin_y_reg is a signal (-1 to +1) */ + yy_reg = phase_reg + index_x1_sample_reg * sin_y_reg; + /* so yy_reg is a table index */ + while (yy_reg > SINE_TABLE_LEN) yy_reg -= SINE_TABLE_LEN; + while (yy_reg < 0) yy_reg += SINE_TABLE_LEN; + sin_y_reg = sine_table[(int) yy_reg]; /* truncation gets valid index */ + /* sin_y_reg is now a signal not ready for table lookup */ + *out_ptr_reg++ = sin_y_reg;; + index_pHaSe_ReG += index_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->yy = yy_reg; + susp->sin_y = sin_y_reg; + susp->phase = phase_reg; + susp->index_pHaSe = index_pHaSe_ReG; + susp->index_x1_sample = index_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; + } +} /* fmfbv_i_fetch */ + + +void fmfbv_r_fetch(register fmfbv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type index_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double yy_reg; + register double sin_y_reg; + register double phase_reg; + register double ph_incr_reg; + falloc_sample_block(out, "fmfbv_r_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->index_pHaSe = 1.0; + } + + susp_check_term_log_samples(index, index_ptr, index_cnt); + + 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; + + /* grab next index_x1_sample when phase goes past 1.0; */ + /* use index_n (computed below) to avoid roundoff errors: */ + if (susp->index_n <= 0) { + susp_check_term_log_samples(index, index_ptr, index_cnt); + susp->index_x1_sample = susp_fetch_sample(index, index_ptr, index_cnt); + susp->index_pHaSe -= 1.0; + /* index_n gets number of samples before phase exceeds 1.0: */ + susp->index_n = (long) ((1.0 - susp->index_pHaSe) * + susp->output_per_index); + } + togo = min(togo, susp->index_n); + index_val = susp->index_x1_sample; + /* 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; + yy_reg = susp->yy; + sin_y_reg = susp->sin_y; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +phase_reg += ph_incr_reg; + if (phase_reg > SINE_TABLE_LEN) phase_reg -= SINE_TABLE_LEN; + /* PHASE is incremented and INDEX scaled to table INDEX, and + sin_y_reg is a signal (-1 to +1) */ + yy_reg = phase_reg + index_val * sin_y_reg; + /* so yy_reg is a table index */ + while (yy_reg > SINE_TABLE_LEN) yy_reg -= SINE_TABLE_LEN; + while (yy_reg < 0) yy_reg += SINE_TABLE_LEN; + sin_y_reg = sine_table[(int) yy_reg]; /* truncation gets valid index */ + /* sin_y_reg is now a signal not ready for table lookup */ + *out_ptr_reg++ = sin_y_reg;; + } while (--n); /* inner loop */ + + susp->yy = yy_reg; + susp->sin_y = sin_y_reg; + susp->phase = phase_reg; + out_ptr += togo; + susp->index_pHaSe += togo * susp->index_pHaSe_iNcR; + susp->index_n -= 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; + } +} /* fmfbv_r_fetch */ + + +void fmfbv_toss_fetch(susp, snd_list) + register fmfbv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from index up to final_time for this block of zeros */ + while ((round((final_time - susp->index->t0) * susp->index->sr)) >= + susp->index->current) + susp_get_samples(index, index_ptr, index_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->index->t0) * susp->index->sr - + (susp->index->current - susp->index_cnt)); + susp->index_ptr += n; + susp_took(index_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void fmfbv_mark(fmfbv_susp_type susp) +{ + sound_xlmark(susp->index); +} + + +void fmfbv_free(fmfbv_susp_type susp) +{ + sound_unref(susp->index); + ffree_generic(susp, sizeof(fmfbv_susp_node), "fmfbv_free"); +} + + +void fmfbv_print_tree(fmfbv_susp_type susp, int n) +{ + indent(n); + stdputstr("index:"); + sound_print_tree_1(susp->index, n); +} + + +sound_type snd_make_fmfbv(time_type t0, double hz, rate_type sr, sound_type index) +{ + register fmfbv_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, fmfbv_susp_node, "snd_make_fmfbv"); + susp->yy = 0.0; + susp->sin_y = 0.0; + susp->phase = 0.0; + susp->ph_incr = hz * SINE_TABLE_LEN / sr; + index->scale *= SINE_TABLE_LEN / PI2 +; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(index, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = fmfbv_n_fetch; break; + case INTERP_s: susp->susp.fetch = fmfbv_s_fetch; break; + case INTERP_i: susp->susp.fetch = fmfbv_i_fetch; break; + case INTERP_r: susp->susp.fetch = fmfbv_r_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < index->t0) sound_prepend_zeros(index, t0); + /* minimum start time over all inputs: */ + t0_min = min(index->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 = fmfbv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = fmfbv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = fmfbv_mark; + susp->susp.print_tree = fmfbv_print_tree; + susp->susp.name = "fmfbv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(index); + susp->started = false; + susp->susp.current = 0; + susp->index = index; + susp->index_cnt = 0; + susp->index_pHaSe = 0.0; + susp->index_pHaSe_iNcR = index->sr / sr; + susp->index_n = 0; + susp->output_per_index = sr / index->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_fmfbv(time_type t0, double hz, rate_type sr, sound_type index) +{ + sound_type index_copy = sound_copy(index); + return snd_make_fmfbv(t0, hz, sr, index_copy); +} diff --git a/tran/fmfbv.h b/tran/fmfbv.h new file mode 100644 index 0000000..ffb11a7 --- /dev/null +++ b/tran/fmfbv.h @@ -0,0 +1,4 @@ +sound_type snd_make_fmfbv(time_type t0, double hz, rate_type sr, sound_type index); +sound_type snd_fmfbv(time_type t0, double hz, rate_type sr, sound_type index); + /* LISP: (snd-fmfbv ANYNUM ANYNUM ANYNUM SOUND) */ +#include "sine.h" /* sine_table and SINE_TABLE_LEN */ diff --git a/tran/fmosc.alg b/tran/fmosc.alg new file mode 100644 index 0000000..1bbbc98 --- /dev/null +++ b/tran/fmosc.alg @@ -0,0 +1,39 @@ +(FMOSC-ALG +(NAME "fmosc") +(ARGUMENTS ("sound_type" "s") ("double" "step") ("rate_type" "sr") + ("double" "hz") ("time_type" "t0") ("sound_type" "s_fm") + ("double" "phase")) +(TABLE "s") +(NOT-IN-INNER-LOOP "s") +(STATE ("table_type" "the_table" "sound_to_table(s)") + ("double" "table_len" "susp->the_table->length") + ("double" "ph_incr" "0") + ("sample_type *" "table_ptr" "susp->the_table->samples") + ("double" "phase" "compute_phase(phase, step, (long) susp->table_len, + s->sr, sr, hz, &susp->ph_incr); + s_fm->scale *= hz != 0 ? (sample_type) (susp->ph_incr / hz) + : s->sr / (sr * step_to_hz(step))") ) ; cancel 0/0 + +(ALWAYS-SCALE s_fm) +(INLINE-INTERPOLATION T) ; so that modulation can be low frequency +(STEP-FUNCTION s_fm) +(TERMINATE (MIN s_fm)) +(LOGICAL-STOP (MIN s_fm)) +(INNER-LOOP-LOCALS " long table_index; + double x1; +") +(INNER-LOOP "table_index = (long) phase; + x1 = table_ptr[table_index]; + output = (sample_type) (x1 + (phase - table_index) * + (table_ptr[table_index + 1] - x1)); + phase += ph_incr + s_fm; + while (phase > table_len) phase -= table_len; + /* watch out for negative frequencies! */ + while (phase < 0) phase += table_len") +(CONSTANT "ph_incr" "table_len" "table_ptr" "table") + +(SAMPLE-RATE "sr") +(FINALIZATION " table_unref(susp->the_table); +") +) + diff --git a/tran/fmosc.c b/tran/fmosc.c new file mode 100644 index 0000000..cbff1be --- /dev/null +++ b/tran/fmosc.c @@ -0,0 +1,494 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "fmosc.h" + +void fmosc_free(); + + +typedef struct fmosc_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s_fm; + long s_fm_cnt; + sample_block_values_type s_fm_ptr; + + /* support for interpolation of s_fm */ + sample_type s_fm_x1_sample; + double s_fm_pHaSe; + double s_fm_pHaSe_iNcR; + + /* support for ramp between samples of s_fm */ + double output_per_s_fm; + long s_fm_n; + + table_type the_table; + double table_len; + double ph_incr; + sample_type *table_ptr; + double phase; +} fmosc_susp_node, *fmosc_susp_type; + + +void fmosc_s_fetch(register fmosc_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 double table_len_reg; + register double ph_incr_reg; + register sample_type * table_ptr_reg; + register double phase_reg; + register sample_type s_fm_scale_reg = susp->s_fm->scale; + register sample_block_values_type s_fm_ptr_reg; + falloc_sample_block(out, "fmosc_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 s_fm input sample block: */ + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + togo = min(togo, susp->s_fm_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; + table_len_reg = susp->table_len; + ph_incr_reg = susp->ph_incr; + table_ptr_reg = susp->table_ptr; + phase_reg = susp->phase; + s_fm_ptr_reg = susp->s_fm_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; +table_index = (long) phase_reg; + x1 = table_ptr_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)); + phase_reg += ph_incr_reg + (s_fm_scale_reg * *s_fm_ptr_reg++); + while (phase_reg > table_len_reg) phase_reg -= table_len_reg; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += table_len_reg; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + /* using s_fm_ptr_reg is a bad idea on RS/6000: */ + susp->s_fm_ptr += togo; + out_ptr += togo; + susp_took(s_fm_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; + } +} /* fmosc_s_fetch */ + + +void fmosc_i_fetch(register fmosc_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 double table_len_reg; + register double ph_incr_reg; + register sample_type * table_ptr_reg; + register double phase_reg; + register double s_fm_pHaSe_iNcR_rEg = susp->s_fm_pHaSe_iNcR; + register double s_fm_pHaSe_ReG; + register sample_type s_fm_x1_sample_reg; + falloc_sample_block(out, "fmosc_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_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + } + + 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); + /* 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; + table_len_reg = susp->table_len; + ph_incr_reg = susp->ph_incr; + table_ptr_reg = susp->table_ptr; + phase_reg = susp->phase; + s_fm_pHaSe_ReG = susp->s_fm_pHaSe; + s_fm_x1_sample_reg = susp->s_fm_x1_sample; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; + if (s_fm_pHaSe_ReG >= 1.0) { +/* fixup-depends s_fm */ + /* pick up next sample as s_fm_x1_sample: */ + susp->s_fm_ptr++; + susp_took(s_fm_cnt, 1); + s_fm_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(s_fm, s_fm_ptr, s_fm_cnt, s_fm_x1_sample_reg); + s_fm_x1_sample_reg = susp_current_sample(s_fm, s_fm_ptr); + } +table_index = (long) phase_reg; + x1 = table_ptr_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)); + phase_reg += ph_incr_reg + s_fm_x1_sample_reg; + while (phase_reg > table_len_reg) phase_reg -= table_len_reg; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += table_len_reg; + s_fm_pHaSe_ReG += s_fm_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->phase = phase_reg; + susp->s_fm_pHaSe = s_fm_pHaSe_ReG; + susp->s_fm_x1_sample = s_fm_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; + } +} /* fmosc_i_fetch */ + + +void fmosc_r_fetch(register fmosc_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type s_fm_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double table_len_reg; + register double ph_incr_reg; + register sample_type * table_ptr_reg; + register double phase_reg; + falloc_sample_block(out, "fmosc_r_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->s_fm_pHaSe = 1.0; + } + + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + + 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; + + /* grab next s_fm_x1_sample when phase goes past 1.0; */ + /* use s_fm_n (computed below) to avoid roundoff errors: */ + if (susp->s_fm_n <= 0) { + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_pHaSe -= 1.0; + /* s_fm_n gets number of samples before phase exceeds 1.0: */ + susp->s_fm_n = (long) ((1.0 - susp->s_fm_pHaSe) * + susp->output_per_s_fm); + } + togo = min(togo, susp->s_fm_n); + s_fm_val = susp->s_fm_x1_sample; + /* 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; + table_len_reg = susp->table_len; + ph_incr_reg = susp->ph_incr; + table_ptr_reg = susp->table_ptr; + phase_reg = susp->phase; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; +table_index = (long) phase_reg; + x1 = table_ptr_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)); + phase_reg += ph_incr_reg + s_fm_val; + while (phase_reg > table_len_reg) phase_reg -= table_len_reg; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += table_len_reg; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + out_ptr += togo; + susp->s_fm_pHaSe += togo * susp->s_fm_pHaSe_iNcR; + susp->s_fm_n -= 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; + } +} /* fmosc_r_fetch */ + + +void fmosc_toss_fetch(susp, snd_list) + register fmosc_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s_fm up to final_time for this block of zeros */ + while ((round((final_time - susp->s_fm->t0) * susp->s_fm->sr)) >= + susp->s_fm->current) + susp_get_samples(s_fm, s_fm_ptr, s_fm_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s_fm->t0) * susp->s_fm->sr - + (susp->s_fm->current - susp->s_fm_cnt)); + susp->s_fm_ptr += n; + susp_took(s_fm_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void fmosc_mark(fmosc_susp_type susp) +{ + sound_xlmark(susp->s_fm); +} + + +void fmosc_free(fmosc_susp_type susp) +{ + table_unref(susp->the_table); + sound_unref(susp->s_fm); + ffree_generic(susp, sizeof(fmosc_susp_node), "fmosc_free"); +} + + +void fmosc_print_tree(fmosc_susp_type susp, int n) +{ + indent(n); + stdputstr("s_fm:"); + sound_print_tree_1(susp->s_fm, n); +} + + +sound_type snd_make_fmosc(sound_type s, double step, rate_type sr, double hz, time_type t0, sound_type s_fm, double phase) +{ + register fmosc_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, fmosc_susp_node, "snd_make_fmosc"); + susp->the_table = sound_to_table(s); + susp->table_len = susp->the_table->length; + susp->ph_incr = 0; + susp->table_ptr = susp->the_table->samples; + susp->phase = compute_phase(phase, step, (long) susp->table_len, + s->sr, sr, hz, &susp->ph_incr); + s_fm->scale *= hz != 0 ? (sample_type) (susp->ph_incr / hz) + : s->sr / (sr * step_to_hz(step)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s_fm, sr); + switch (interp_desc) { + case INTERP_n: /* handled below */ + case INTERP_s: susp->susp.fetch = fmosc_s_fetch; break; + case INTERP_i: susp->susp.fetch = fmosc_i_fetch; break; + case INTERP_r: susp->susp.fetch = fmosc_r_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s_fm->t0) sound_prepend_zeros(s_fm, t0); + /* minimum start time over all inputs: */ + t0_min = min(s_fm->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 = fmosc_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = fmosc_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = fmosc_mark; + susp->susp.print_tree = fmosc_print_tree; + susp->susp.name = "fmosc"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s_fm); + susp->started = false; + susp->susp.current = 0; + susp->s_fm = s_fm; + susp->s_fm_cnt = 0; + susp->s_fm_pHaSe = 0.0; + susp->s_fm_pHaSe_iNcR = s_fm->sr / sr; + susp->s_fm_n = 0; + susp->output_per_s_fm = sr / s_fm->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_fmosc(sound_type s, double step, rate_type sr, double hz, time_type t0, sound_type s_fm, double phase) +{ + sound_type s_fm_copy = sound_copy(s_fm); + return snd_make_fmosc(s, step, sr, hz, t0, s_fm_copy, phase); +} diff --git a/tran/fmosc.h b/tran/fmosc.h new file mode 100644 index 0000000..c3724de --- /dev/null +++ b/tran/fmosc.h @@ -0,0 +1,3 @@ +sound_type snd_make_fmosc(sound_type s, double step, rate_type sr, double hz, time_type t0, sound_type s_fm, double phase); +sound_type snd_fmosc(sound_type s, double step, rate_type sr, double hz, time_type t0, sound_type s_fm, double phase); + /* LISP: (snd-fmosc SOUND ANYNUM ANYNUM ANYNUM ANYNUM SOUND ANYNUM) */ diff --git a/tran/follow.alg b/tran/follow.alg new file mode 100644 index 0000000..9765897 --- /dev/null +++ b/tran/follow.alg @@ -0,0 +1,106 @@ +(FOLLOW-ALG +(NAME "follow") +(SUPPORT-FUNCTIONS +"/* Description: this is a sophisticated envelope follower. + The input is an envelope, e.g. something produced with + the AVG function. The purpose of this function is to + generate a smooth envelope that is generally not less + than the input signal. In other words, we want to \"ride\" + the peaks of the signal with a smooth function. The + algorithm is as follows: keep a current output value + (called the \"value\"). The value is allowed to increase + by at most rise_factor and decrease by at most fall_factor. + Therefore, the next value should be between + value * rise_factor and value * fall_factor. If the input + is in this range, then the next value is simply the input. + If the input is less than value * fall_factor, then the + next value is just value * fall_factor, which will be greater + than the input signal. If the input is greater than value * + rise_factor, then we compute a rising envelope that meets + the input value by working bacwards in time, changing the + previous values to input / rise_factor, input / rise_factor^2, + input / rise_factor^3, etc. until this new envelope intersects + the previously computed values. There is only a limited buffer + in which we can work backwards, so if the new envelope does not + intersect the old one, then make yet another pass, this time + from the oldest buffered value forward, increasing on each + sample by rise_factor to produce a maximal envelope. This will + still be less than the input. + + The value has a lower limit of floor to make sure value has a + reasonable positive value from which to begin an attack. + + Because this algorithm can make 2 passes through the buffer on + sharply rising input signals, it is not particularly fast. The + assumption is that it operates on fairly short buffers at low + sample rates appropriate for gain control, so this should not + matter. + */ + +static sample_type *create_buf(double floor, long lookahead) +{ + sample_type *buf = (sample_type *) malloc(lookahead * sizeof(sample_type)); + int i; + + for (i = 0; i < lookahead; i++) buf[i] = (sample_type) floor; + return buf; +} +") +(ARGUMENTS ("sound_type" "sndin") ("double" "floor") ("double" "risetime") + ("double" "falltime") ("long" "lookahead")) +(START (MIN sndin)) +(STATE ("long" "lookahead" "lookahead = lookahead + 1") + ("sample_type *" "delaybuf" "create_buf(floor, lookahead)") + ("sample_type *" "delayptr" "susp->delaybuf") + ("sample_type *" "prevptr" "susp->delaybuf + lookahead - 1; + *(susp->prevptr) = (sample_type) floor;") + ("sample_type *" "endptr" "susp->delaybuf + lookahead") + ("double" "floor" "floor; floor = log(floor);") + ("double" "rise_factor" "exp(- floor / (sndin->sr * risetime + 0.5))") + ("double" "fall_factor" "exp(floor / (sndin->sr * falltime + 0.5))") + ("double" "value" "susp->floor")) +(CONSTANT "feedback" "rise_factor" "fall_factor" "endptr") +(NOT-REGISTER delaybuf) +(ALWAYS-SCALE sndin) +(TERMINATE (MIN sndin)) +(INNER-LOOP " sample_type current = sndin; + sample_type high = (sample_type) (*prevptr * rise_factor); + sample_type low = (sample_type) (*prevptr * fall_factor); + if (low < floor) low = (sample_type) floor; + if (current < low) *delayptr = (sample_type) low; + else if (current < high) *delayptr = current; + else /* current > high */ { + /* work back from current */ + double rise_inverse = 1.0 / rise_factor; + double temp = current * rise_inverse; + boolean ok = false; + sample_type *ptr = prevptr; + int i; + + for (i = 0; i < lookahead - 2; i++) { + if (*ptr < temp) { + *ptr-- = (sample_type) temp; + temp *= rise_inverse; + if (ptr < susp->delaybuf) + ptr = endptr - 1; + } else { + ok = true; + break; + } + } + if (!ok && (*ptr < temp)) { + temp = *ptr; + for (i = 0; i < lookahead - 1; i++) { + ptr++; + if (ptr == endptr) ptr = susp->delaybuf; + temp *= rise_factor; + *ptr = (sample_type) temp; + } + } else *delayptr = current; + } + prevptr = delayptr++; + if (delayptr == endptr) delayptr = susp->delaybuf; + output = *delayptr;") +(FINALIZATION "free(susp->delaybuf);") +) + diff --git a/tran/follow.c b/tran/follow.c new file mode 100644 index 0000000..695c4b6 --- /dev/null +++ b/tran/follow.c @@ -0,0 +1,286 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "follow.h" + +void follow_free(); + + +typedef struct follow_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type sndin; + long sndin_cnt; + sample_block_values_type sndin_ptr; + + long lookahead; + sample_type *delaybuf; + sample_type *delayptr; + sample_type *prevptr; + sample_type *endptr; + double floor; + double rise_factor; + double fall_factor; + double value; +} follow_susp_node, *follow_susp_type; + +/* Description: this is a sophisticated envelope follower. + The input is an envelope, e.g. something produced with + the AVG function. The purpose of this function is to + generate a smooth envelope that is generally not less + than the input signal. In other words, we want to "ride" + the peaks of the signal with a smooth function. The + algorithm is as follows: keep a current output value + (called the "value"). The value is allowed to increase + by at most rise_factor and decrease by at most fall_factor. + Therefore, the next value should be between + value * rise_factor and value * fall_factor. If the input + is in this range, then the next value is simply the input. + If the input is less than value * fall_factor, then the + next value is just value * fall_factor, which will be greater + than the input signal. If the input is greater than value * + rise_factor, then we compute a rising envelope that meets + the input value by working bacwards in time, changing the + previous values to input / rise_factor, input / rise_factor^2, + input / rise_factor^3, etc. until this new envelope intersects + the previously computed values. There is only a limited buffer + in which we can work backwards, so if the new envelope does not + intersect the old one, then make yet another pass, this time + from the oldest buffered value forward, increasing on each + sample by rise_factor to produce a maximal envelope. This will + still be less than the input. + + The value has a lower limit of floor to make sure value has a + reasonable positive value from which to begin an attack. + + Because this algorithm can make 2 passes through the buffer on + sharply rising input signals, it is not particularly fast. The + assumption is that it operates on fairly short buffers at low + sample rates appropriate for gain control, so this should not + matter. + */ + +static sample_type *create_buf(double floor, long lookahead) +{ + sample_type *buf = (sample_type *) malloc(lookahead * sizeof(sample_type)); + int i; + + for (i = 0; i < lookahead; i++) buf[i] = (sample_type) floor; + return buf; +} + + +void follow_s_fetch(register follow_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 long lookahead_reg; + register sample_type * delayptr_reg; + register sample_type * prevptr_reg; + register sample_type * endptr_reg; + register double floor_reg; + register double rise_factor_reg; + register double fall_factor_reg; + register sample_type sndin_scale_reg = susp->sndin->scale; + register sample_block_values_type sndin_ptr_reg; + falloc_sample_block(out, "follow_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 sndin input sample block: */ + susp_check_term_samples(sndin, sndin_ptr, sndin_cnt); + togo = min(togo, susp->sndin_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; + lookahead_reg = susp->lookahead; + delayptr_reg = susp->delayptr; + prevptr_reg = susp->prevptr; + endptr_reg = susp->endptr; + floor_reg = susp->floor; + rise_factor_reg = susp->rise_factor; + fall_factor_reg = susp->fall_factor; + sndin_ptr_reg = susp->sndin_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + sample_type current = (sndin_scale_reg * *sndin_ptr_reg++); + sample_type high = (sample_type) (*prevptr_reg * rise_factor_reg); + sample_type low = (sample_type) (*prevptr_reg * fall_factor_reg); + if (low < floor_reg) low = (sample_type) floor_reg; + if (current < low) *delayptr_reg = (sample_type) low; + else if (current < high) *delayptr_reg = current; + else /* current > high */ { + /* work back from current */ + double rise_inverse = 1.0 / rise_factor_reg; + double temp = current * rise_inverse; + boolean ok = false; + sample_type *ptr = prevptr_reg; + int i; + + for (i = 0; i < lookahead_reg - 2; i++) { + if (*ptr < temp) { + *ptr-- = (sample_type) temp; + temp *= rise_inverse; + if (ptr < susp->delaybuf) + ptr = endptr_reg - 1; + } else { + ok = true; + break; + } + } + if (!ok && (*ptr < temp)) { + temp = *ptr; + for (i = 0; i < lookahead_reg - 1; i++) { + ptr++; + if (ptr == endptr_reg) ptr = susp->delaybuf; + temp *= rise_factor_reg; + *ptr = (sample_type) temp; + } + } else *delayptr_reg = current; + } + prevptr_reg = delayptr_reg++; + if (delayptr_reg == endptr_reg) delayptr_reg = susp->delaybuf; + *out_ptr_reg++ = *delayptr_reg;; + } while (--n); /* inner loop */ + + togo -= n; + susp->lookahead = lookahead_reg; + susp->delayptr = delayptr_reg; + susp->prevptr = prevptr_reg; + susp->floor = floor_reg; + /* using sndin_ptr_reg is a bad idea on RS/6000: */ + susp->sndin_ptr += togo; + out_ptr += togo; + susp_took(sndin_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; + } +} /* follow_s_fetch */ + + +void follow_toss_fetch(susp, snd_list) + register follow_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from sndin up to final_time for this block of zeros */ + while ((round((final_time - susp->sndin->t0) * susp->sndin->sr)) >= + susp->sndin->current) + susp_get_samples(sndin, sndin_ptr, sndin_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->sndin->t0) * susp->sndin->sr - + (susp->sndin->current - susp->sndin_cnt)); + susp->sndin_ptr += n; + susp_took(sndin_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void follow_mark(follow_susp_type susp) +{ + sound_xlmark(susp->sndin); +} + + +void follow_free(follow_susp_type susp) +{ +free(susp->delaybuf); sound_unref(susp->sndin); + ffree_generic(susp, sizeof(follow_susp_node), "follow_free"); +} + + +void follow_print_tree(follow_susp_type susp, int n) +{ + indent(n); + stdputstr("sndin:"); + sound_print_tree_1(susp->sndin, n); +} + + +sound_type snd_make_follow(sound_type sndin, double floor, double risetime, double falltime, long lookahead) +{ + register follow_susp_type susp; + rate_type sr = sndin->sr; + time_type t0 = sndin->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, follow_susp_node, "snd_make_follow"); + susp->lookahead = lookahead = lookahead + 1; + susp->delaybuf = create_buf(floor, lookahead); + susp->delayptr = susp->delaybuf; + susp->prevptr = susp->delaybuf + lookahead - 1; + *(susp->prevptr) = (sample_type) floor;; + susp->endptr = susp->delaybuf + lookahead; + susp->floor = floor; floor = log(floor);; + susp->rise_factor = exp(- floor / (sndin->sr * risetime + 0.5)); + susp->fall_factor = exp(floor / (sndin->sr * falltime + 0.5)); + susp->value = susp->floor; + susp->susp.fetch = follow_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < sndin->t0) sound_prepend_zeros(sndin, t0); + /* minimum start time over all inputs: */ + t0_min = min(sndin->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 = follow_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = follow_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = follow_mark; + susp->susp.print_tree = follow_print_tree; + susp->susp.name = "follow"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->sndin = sndin; + susp->sndin_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_follow(sound_type sndin, double floor, double risetime, double falltime, long lookahead) +{ + sound_type sndin_copy = sound_copy(sndin); + return snd_make_follow(sndin_copy, floor, risetime, falltime, lookahead); +} diff --git a/tran/follow.h b/tran/follow.h new file mode 100644 index 0000000..6dbc3bb --- /dev/null +++ b/tran/follow.h @@ -0,0 +1,3 @@ +sound_type snd_make_follow(sound_type sndin, double floor, double risetime, double falltime, long lookahead); +sound_type snd_follow(sound_type sndin, double floor, double risetime, double falltime, long lookahead); + /* LISP: (snd-follow SOUND ANYNUM ANYNUM ANYNUM FIXNUM) */ diff --git a/tran/fromarraystream.alg b/tran/fromarraystream.alg new file mode 100644 index 0000000..4ae2254 --- /dev/null +++ b/tran/fromarraystream.alg @@ -0,0 +1,82 @@ +(FRMASTRM-ALG + (NAME "fromarraystream") + (ARGUMENTS ("time_type" "t0") ("rate_type" "sr") ("LVAL" "src")) + (SUPPORT-FUNCTIONS " +/* IMPLEMENTATION NOTE: + * The src argument is an XLisp object that returns either an + * array of samples or NIL. The output of ifft is simply the + * concatenation of the samples taken from the array. Later, + * an ifft will be plugged in and this will return overlapped + * adds of the ifft's. + */ + +#include \"samples.h\" +") + + (SAMPLE-RATE "sr") + (STATE + ("long" "index" "0") ; samples index + ("long" "length" "0"); samples length + ("LVAL" "array" "NULL") + ("LVAL" "src" "src") + ("sample_type *" "samples" "NULL;")) + + (OUTER-LOOP " + if (susp->src == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + if (susp->index >= susp->length) { + long i; + susp->index = 0; + susp->array = xleval(cons(s_send, cons(susp->src, consa(s_next)))); + susp->index = 0; + if (susp->array == NULL) { + susp->src = NULL; + goto out; + } else if (!vectorp(susp->array)) { + xlerror(\"array expected\", susp->array); + } else if (susp->samples == NULL) { + /* assume arrays are all the same size as first one; + now that we know the size, we just have to do this + first allocation. + */ + susp->length = getsize(susp->array); + if (susp->length < 1) xlerror(\"array has no elements\", susp->array); + susp->samples = + (sample_type *) calloc(susp->length, + sizeof(sample_type)); + } else if (getsize(susp->array) != susp->length) { + xlerror(\"arrays must all be the same length\", susp->array); + } + /* at this point, we have a new array and a place to put samples */ + for (i = 0; i < susp->length; i++) { + LVAL elem = getelement(susp->array, i); + if (ntype(elem) != FLONUM) { + xlerror(\"flonum expected\", elem); + } + susp->samples[i] = (sample_type) getflonum(elem); + } + susp->array = NULL; /* free the array */ + } + togo = min(togo, susp->length - susp->index); +") + (INNER-LOOP "output = samples[index++];") + (CONSTANT "length" "samples" "array" "src") + (TERMINATE COMPUTED) + (FINALIZATION " free(susp->samples); +") + +) + + + + + + + + + + + + diff --git a/tran/fromarraystream.c b/tran/fromarraystream.c new file mode 100644 index 0000000..7df0a9b --- /dev/null +++ b/tran/fromarraystream.c @@ -0,0 +1,170 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "fromarraystream.h" + +void fromarraystream_free(); + + +typedef struct fromarraystream_susp_struct { + snd_susp_node susp; + + long index; + long length; + LVAL array; + LVAL src; + sample_type *samples; +} fromarraystream_susp_node, *fromarraystream_susp_type; + + +/* IMPLEMENTATION NOTE: + * The src argument is an XLisp object that returns either an + * array of samples or NIL. The output of ifft is simply the + * concatenation of the samples taken from the array. Later, + * an ifft will be plugged in and this will return overlapped + * adds of the ifft's. + */ + +#include "samples.h" + + +void fromarraystream__fetch(register fromarraystream_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 long index_reg; + register sample_type * samples_reg; + falloc_sample_block(out, "fromarraystream__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; + + + if (susp->src == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + if (susp->index >= susp->length) { + long i; + susp->index = 0; + susp->array = xleval(cons(s_send, cons(susp->src, consa(s_next)))); + susp->index = 0; + if (susp->array == NULL) { + susp->src = NULL; + goto out; + } else if (!vectorp(susp->array)) { + xlerror("array expected", susp->array); + } else if (susp->samples == NULL) { + /* assume arrays are all the same size as first one; + now that we know the size, we just have to do this + first allocation. + */ + susp->length = getsize(susp->array); + if (susp->length < 1) xlerror("array has no elements", susp->array); + susp->samples = + (sample_type *) calloc(susp->length, + sizeof(sample_type)); + } else if (getsize(susp->array) != susp->length) { + xlerror("arrays must all be the same length", susp->array); + } + /* at this point, we have a new array and a place to put samples */ + for (i = 0; i < susp->length; i++) { + LVAL elem = getelement(susp->array, i); + if (ntype(elem) != FLONUM) { + xlerror("flonum expected", elem); + } + susp->samples[i] = (sample_type) getflonum(elem); + } + susp->array = NULL; /* free the array */ + } + togo = min(togo, susp->length - susp->index); + + n = togo; + index_reg = susp->index; + samples_reg = susp->samples; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = samples_reg[index_reg++];; + } while (--n); /* inner loop */ + + susp->index = index_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; + } +} /* fromarraystream__fetch */ + + +void fromarraystream_mark(fromarraystream_susp_type susp) +{ + if (susp->src) mark(susp->src); + if (susp->array) mark(susp->array); +} + + +void fromarraystream_free(fromarraystream_susp_type susp) +{ + free(susp->samples); + ffree_generic(susp, sizeof(fromarraystream_susp_node), "fromarraystream_free"); +} + + +void fromarraystream_print_tree(fromarraystream_susp_type susp, int n) +{ +} + + +sound_type snd_make_fromarraystream(time_type t0, rate_type sr, LVAL src) +{ + register fromarraystream_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, fromarraystream_susp_node, "snd_make_fromarraystream"); + susp->index = 0; + susp->length = 0; + susp->array = NULL; + susp->src = src; + susp->samples = NULL;; + susp->susp.fetch = fromarraystream__fetch; + + /* initialize susp state */ + susp->susp.free = fromarraystream_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = fromarraystream_mark; + susp->susp.print_tree = fromarraystream_print_tree; + susp->susp.name = "fromarraystream"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_fromarraystream(time_type t0, rate_type sr, LVAL src) +{ + return snd_make_fromarraystream(t0, sr, src); +} diff --git a/tran/fromarraystream.h b/tran/fromarraystream.h new file mode 100644 index 0000000..51a5a60 --- /dev/null +++ b/tran/fromarraystream.h @@ -0,0 +1,3 @@ +sound_type snd_make_fromarraystream(time_type t0, rate_type sr, LVAL src); +sound_type snd_fromarraystream(time_type t0, rate_type sr, LVAL src); + /* LISP: (snd-fromarraystream ANYNUM ANYNUM ANY) */ diff --git a/tran/fromobject.alg b/tran/fromobject.alg new file mode 100644 index 0000000..f119a7f --- /dev/null +++ b/tran/fromobject.alg @@ -0,0 +1,37 @@ +(FROMOBJ-ALG + (NAME "fromobject") + (ARGUMENTS ("time_type" "t0") ("rate_type" "sr") ("LVAL" "src")) + (SUPPORT-FUNCTIONS " +/* IMPLEMENTATION NOTE: + * The src argument is an XLisp object that returns either a + * FLONUM sample or NIL. The output of fromobj is simply the + * sequence of the samples. + */ + +#include \"samples.h\" +") + + (SAMPLE-RATE "sr") + (STATE + ("boolean" "done" "false") + ("LVAL" "src" "src")) + + (OUTER-LOOP " if (susp->done) { + togo = 0; /* indicate termination */ + break; /* we're done */ + } +") + (INNER-LOOP +" LVAL rslt = xleval(cons(s_send, cons(src, + consa(s_next)))); + if (floatp(rslt)) { + output = (sample_type) getflonum(rslt); + } else { + done = true; + /* adjust togo to what it should have been */ + break; + }") + (CONSTANT "length" "samples" "array" "src") + (TERMINATE COMPUTED) +) + diff --git a/tran/fromobject.c b/tran/fromobject.c new file mode 100644 index 0000000..f744a9d --- /dev/null +++ b/tran/fromobject.c @@ -0,0 +1,134 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "fromobject.h" + +void fromobject_free(); + + +typedef struct fromobject_susp_struct { + snd_susp_node susp; + + boolean done; + LVAL src; +} fromobject_susp_node, *fromobject_susp_type; + + +/* IMPLEMENTATION NOTE: + * The src argument is an XLisp object that returns either a + * FLONUM sample or NIL. The output of fromobj is simply the + * sequence of the samples. + */ + +#include "samples.h" + + +void fromobject__fetch(register fromobject_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 boolean done_reg; + register LVAL src_reg; + falloc_sample_block(out, "fromobject__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; + + if (susp->done) { + togo = 0; /* indicate termination */ + break; /* we're done */ + } + + n = togo; + done_reg = susp->done; + src_reg = susp->src; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + LVAL rslt = xleval(cons(s_send, cons(src_reg, + consa(s_next)))); + if (floatp(rslt)) { + *out_ptr_reg++ = (sample_type) getflonum(rslt); + } else { + done_reg = true; + /* adjust togo to what it should have been */ + break; + }; + } while (--n); /* inner loop */ + + togo -= n; + susp->done = done_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; + } +} /* fromobject__fetch */ + + +void fromobject_mark(fromobject_susp_type susp) +{ + if (susp->src) mark(susp->src); +} + + +void fromobject_free(fromobject_susp_type susp) +{ + ffree_generic(susp, sizeof(fromobject_susp_node), "fromobject_free"); +} + + +void fromobject_print_tree(fromobject_susp_type susp, int n) +{ +} + + +sound_type snd_make_fromobject(time_type t0, rate_type sr, LVAL src) +{ + register fromobject_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, fromobject_susp_node, "snd_make_fromobject"); + susp->done = false; + susp->src = src; + susp->susp.fetch = fromobject__fetch; + + /* initialize susp state */ + susp->susp.free = fromobject_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = fromobject_mark; + susp->susp.print_tree = fromobject_print_tree; + susp->susp.name = "fromobject"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_fromobject(time_type t0, rate_type sr, LVAL src) +{ + return snd_make_fromobject(t0, sr, src); +} diff --git a/tran/fromobject.h b/tran/fromobject.h new file mode 100644 index 0000000..b8d560d --- /dev/null +++ b/tran/fromobject.h @@ -0,0 +1,3 @@ +sound_type snd_make_fromobject(time_type t0, rate_type sr, LVAL src); +sound_type snd_fromobject(time_type t0, rate_type sr, LVAL src); + /* LISP: (snd-fromobject ANYNUM ANYNUM ANY) */ diff --git a/tran/gate.alg b/tran/gate.alg new file mode 100644 index 0000000..eb3e0a4 --- /dev/null +++ b/tran/gate.alg @@ -0,0 +1,166 @@ +(GATE-ALG +(NAME "gate") +(ARGUMENTS ("sound_type" "signal") ("time_type" "lookahead") ("double" "risetime") + ("double" "falltime") ("double" "floor") ("double" "threshold")) +(START (MIN signal)) +(SUPPORT-FUNCTIONS "#define ST_HOLD 0 +#define ST_FALL 1 +#define ST_FALL_UNTIL 2 +#define ST_OFF 3 +#define ST_OFF_UNTIL 4 +#define ST_RISE 5 + +/* Overview: +This operation generates an exponential rise and decay suitable for implementing a +noise gate. The decay starts when the signal drops below threshold and stays there +for longer than lookahead. +Decay continues until the value reaches floor, at which point the decay stops +and the value is held constant. Either during the decay or after the floor is reached, +if the signal goes above threshold, then the output value will rise to 1.0 (0dB) at +the point the signal crosses the threshold. Again, lookahead is used, so the rise +actually starts before the signal crosses the threshold. The rise rate is constant +and set so that a rise from floor to 0dB occurs in the specified risetime. Similarly, +the fall rate is constant such that a fall from 0dB to the floor takes falltime. + +Rather than looking ahead, the output actually lags the input by lookahead. The caller +should advance the time of the input signal in order to get a correct output signal, +and this will be taken care of in Lisp code. + +The implementation is a finite-state machine that simultaneously computes the value +and scans ahead for threshold crossings. Time points, remembered as sample counts are +saved in variables: + on_count -- the time at which the rise should complete + off_count -- the time at which the fall should begin + rise_factor -- multiply by this to get exponential rise + fall_factor -- multiply by this to get exponential fall + rise_time -- number of samples for a full rise + fall_time -- number of samples for a full fall + floor -- the lowest value to output + threshold -- compare the signal s to this value + start_rise -- the sample count at which a rise begins + delay_len -- number of samples to look ahead, length of buffer + state -- the current state of finite state machine + (see the individual 'case' statements for description of states) + value -- the current output value + +computing fall_factor: + factor ^ (sample_rate * time) == floor + log(factor) * sample_rate * time == log(floor) + log(factor) == log(floor) / (sample_rate * time) + factor == exp(log(floor) / (sample_rate * time)) + +*/ + +void compute_start_rise(gate_susp_type susp) +{ + /* to compute when to start rise to achieve 0dB at on_count: + By similar triangles: + truncated rise time truncated fall time + ------------------- == ------------------- + full rise time full fall time + when you enter ST_FALL, set start_fall = now + then if (on_count - start_fall) < (rise_time + fall_time) + then start rise at + on_time - rise_time * (on_count-start_fall)/(rise_time+fall_time) + */ + long total = (long) (susp->rise_time + susp->fall_time); + if ((susp->on_count - susp->start_fall) < total) { + susp->start_rise = (long) (susp->on_count - + (susp->rise_time * susp->on_count - susp->start_fall) / total); + } else susp->start_rise = (long) (susp->on_count - susp->rise_time); +} +") +(STATE + ("double" "rise_time" "signal->sr * risetime + 0.5") + ("double" "fall_time" "signal->sr * falltime + 0.5") + ("double" "floor" "floor; floor = log(floor);") + ("double" "threshold" "threshold") + ("long" "on_count" "0") + ("long" "off_count" "0") + ("double" "rise_factor" "exp(- floor / susp->rise_time)") + ("double" "fall_factor" "exp(floor / susp->fall_time)") + ("long" "start_fall" "0") + ("long" "start_rise" "0") + ("long" "stop_count" "0") + ("long" "delay_len" "max(1, round(signal->sr * lookahead))") + ("int" "state" "ST_OFF") + ("double" "value" "susp->floor")) + +(CONSTANT "lookahead" "rise_time" "fall_time" "floor" "threshold" "delay_len" "end_ptr" + "rise_factor" "fall_factor") +(NOT-REGISTER delay_buf rise_factor fall_factor rise_time fall_time floor + on_count start_fall start_rise) +(LINEAR signal) +(TERMINATE (MIN signal)) +(INNER-LOOP "{ + sample_type future = signal; + long now = susp->susp.current + cnt + togo - n; + + switch (state) { + /* hold at 1.0 and look for the moment to begin fall: */ + case ST_HOLD: + if (future >= threshold) { + off_count = now + delay_len; + } else if (now >= off_count) { + state = ST_FALL; + stop_count = (long) (now + susp->fall_time); + susp->start_fall = now; + } + break; + /* fall until stop_count while looking for next rise time */ + case ST_FALL: + if (future >= threshold) { + off_count = susp->on_count = now + delay_len; + compute_start_rise(susp); + state = ST_FALL_UNTIL; + } else if (now == stop_count) { + state = ST_OFF; + value = susp->floor; + } else value *= susp->fall_factor; + break; + /* fall until start_rise while looking for next fall time */ + case ST_FALL_UNTIL: + value *= susp->fall_factor; + if (future >= threshold) { + off_count = now + delay_len; + } + if (now >= susp->start_rise) { + state = ST_RISE; + } else if (now >= stop_count) { + state = ST_OFF_UNTIL; + value = susp->floor; + } + break; + /* hold at floor (minimum value) and look for next rise time */ + case ST_OFF: + if (future >= threshold) { + off_count = susp->on_count = now + delay_len; + compute_start_rise(susp); + state = ST_OFF_UNTIL; + } + break; + /* hold at floor until start_rise while looking for next fall time */ + case ST_OFF_UNTIL: + if (future >= threshold) { + off_count = now + delay_len; + } + if (now >= susp->start_rise) { + state = ST_RISE; + } + break; + /* rise while looking for fall time */ + case ST_RISE: + value *= susp->rise_factor; + if (future >= threshold) { + off_count = now + delay_len; + } + if (now >= susp->on_count) { + value = 1.0; + state = ST_HOLD; + } + break; + } + output = (sample_type) value; + }") +) + diff --git a/tran/gate.c b/tran/gate.c new file mode 100644 index 0000000..eec4a9d --- /dev/null +++ b/tran/gate.c @@ -0,0 +1,353 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "gate.h" + +void gate_free(); + + +typedef struct gate_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type signal; + long signal_cnt; + sample_block_values_type signal_ptr; + + double rise_time; + double fall_time; + double floor; + double threshold; + long on_count; + long off_count; + double rise_factor; + double fall_factor; + long start_fall; + long start_rise; + long stop_count; + long delay_len; + int state; + double value; +} gate_susp_node, *gate_susp_type; + +#define ST_HOLD 0 +#define ST_FALL 1 +#define ST_FALL_UNTIL 2 +#define ST_OFF 3 +#define ST_OFF_UNTIL 4 +#define ST_RISE 5 + +/* Overview: +This operation generates an exponential rise and decay suitable for implementing a +noise gate. The decay starts when the signal drops below threshold and stays there +for longer than lookahead. +Decay continues until the value reaches floor, at which point the decay stops +and the value is held constant. Either during the decay or after the floor is reached, +if the signal goes above threshold, then the output value will rise to 1.0 (0dB) at +the point the signal crosses the threshold. Again, lookahead is used, so the rise +actually starts before the signal crosses the threshold. The rise rate is constant +and set so that a rise from floor to 0dB occurs in the specified risetime. Similarly, +the fall rate is constant such that a fall from 0dB to the floor takes falltime. + +Rather than looking ahead, the output actually lags the input by lookahead. The caller +should advance the time of the input signal in order to get a correct output signal, +and this will be taken care of in Lisp code. + +The implementation is a finite-state machine that simultaneously computes the value +and scans ahead for threshold crossings. Time points, remembered as sample counts are +saved in variables: + on_count -- the time at which the rise should complete + off_count -- the time at which the fall should begin + rise_factor -- multiply by this to get exponential rise + fall_factor -- multiply by this to get exponential fall + rise_time -- number of samples for a full rise + fall_time -- number of samples for a full fall + floor -- the lowest value to output + threshold -- compare the signal s to this value + start_rise -- the sample count at which a rise begins + delay_len -- number of samples to look ahead, length of buffer + state -- the current state of finite state machine + (see the individual 'case' statements for description of states) + value -- the current output value + +computing fall_factor: + factor ^ (sample_rate * time) == floor + log(factor) * sample_rate * time == log(floor) + log(factor) == log(floor) / (sample_rate * time) + factor == exp(log(floor) / (sample_rate * time)) + +*/ + +void compute_start_rise(gate_susp_type susp) +{ + /* to compute when to start rise to achieve 0dB at on_count: + By similar triangles: + truncated rise time truncated fall time + ------------------- == ------------------- + full rise time full fall time + when you enter ST_FALL, set start_fall = now + then if (on_count - start_fall) < (rise_time + fall_time) + then start rise at + on_time - rise_time * (on_count-start_fall)/(rise_time+fall_time) + */ + long total = (long) (susp->rise_time + susp->fall_time); + if ((susp->on_count - susp->start_fall) < total) { + susp->start_rise = (long) (susp->on_count - + (susp->rise_time * susp->on_count - susp->start_fall) / total); + } else susp->start_rise = (long) (susp->on_count - susp->rise_time); +} + + +void gate_n_fetch(register gate_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 double threshold_reg; + register long off_count_reg; + register long stop_count_reg; + register long delay_len_reg; + register int state_reg; + register double value_reg; + register sample_block_values_type signal_ptr_reg; + falloc_sample_block(out, "gate_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 signal input sample block: */ + susp_check_term_samples(signal, signal_ptr, signal_cnt); + togo = min(togo, susp->signal_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; + threshold_reg = susp->threshold; + off_count_reg = susp->off_count; + stop_count_reg = susp->stop_count; + delay_len_reg = susp->delay_len; + state_reg = susp->state; + value_reg = susp->value; + signal_ptr_reg = susp->signal_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ + sample_type future = *signal_ptr_reg++; + long now = susp->susp.current + cnt + togo - n; + + switch (state_reg) { + /* hold at 1.0 and look for the moment to begin fall: */ + case ST_HOLD: + if (future >= threshold_reg) { + off_count_reg = now + delay_len_reg; + } else if (now >= off_count_reg) { + state_reg = ST_FALL; + stop_count_reg = (long) (now + susp->fall_time); + susp->start_fall = now; + } + break; + /* fall until stop_count_reg while looking for next rise time */ + case ST_FALL: + if (future >= threshold_reg) { + off_count_reg = susp->on_count = now + delay_len_reg; + compute_start_rise(susp); + state_reg = ST_FALL_UNTIL; + } else if (now == stop_count_reg) { + state_reg = ST_OFF; + value_reg = susp->floor; + } else value_reg *= susp->fall_factor; + break; + /* fall until start_rise while looking for next fall time */ + case ST_FALL_UNTIL: + value_reg *= susp->fall_factor; + if (future >= threshold_reg) { + off_count_reg = now + delay_len_reg; + } + if (now >= susp->start_rise) { + state_reg = ST_RISE; + } else if (now >= stop_count_reg) { + state_reg = ST_OFF_UNTIL; + value_reg = susp->floor; + } + break; + /* hold at floor (minimum value_reg) and look for next rise time */ + case ST_OFF: + if (future >= threshold_reg) { + off_count_reg = susp->on_count = now + delay_len_reg; + compute_start_rise(susp); + state_reg = ST_OFF_UNTIL; + } + break; + /* hold at floor until start_rise while looking for next fall time */ + case ST_OFF_UNTIL: + if (future >= threshold_reg) { + off_count_reg = now + delay_len_reg; + } + if (now >= susp->start_rise) { + state_reg = ST_RISE; + } + break; + /* rise while looking for fall time */ + case ST_RISE: + value_reg *= susp->rise_factor; + if (future >= threshold_reg) { + off_count_reg = now + delay_len_reg; + } + if (now >= susp->on_count) { + value_reg = 1.0; + state_reg = ST_HOLD; + } + break; + } + *out_ptr_reg++ = (sample_type) value_reg; + }; + } while (--n); /* inner loop */ + + togo -= n; + susp->off_count = off_count_reg; + susp->stop_count = stop_count_reg; + susp->state = state_reg; + susp->value = value_reg; + /* using signal_ptr_reg is a bad idea on RS/6000: */ + susp->signal_ptr += togo; + out_ptr += togo; + susp_took(signal_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; + } +} /* gate_n_fetch */ + + +void gate_toss_fetch(susp, snd_list) + register gate_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from signal up to final_time for this block of zeros */ + while ((round((final_time - susp->signal->t0) * susp->signal->sr)) >= + susp->signal->current) + susp_get_samples(signal, signal_ptr, signal_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->signal->t0) * susp->signal->sr - + (susp->signal->current - susp->signal_cnt)); + susp->signal_ptr += n; + susp_took(signal_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void gate_mark(gate_susp_type susp) +{ + sound_xlmark(susp->signal); +} + + +void gate_free(gate_susp_type susp) +{ + sound_unref(susp->signal); + ffree_generic(susp, sizeof(gate_susp_node), "gate_free"); +} + + +void gate_print_tree(gate_susp_type susp, int n) +{ + indent(n); + stdputstr("signal:"); + sound_print_tree_1(susp->signal, n); +} + + +sound_type snd_make_gate(sound_type signal, time_type lookahead, double risetime, double falltime, double floor, double threshold) +{ + register gate_susp_type susp; + rate_type sr = signal->sr; + time_type t0 = signal->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (SIGNAL) */ + scale_factor *= signal->scale; + signal->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (signal->sr < sr) { signal->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, gate_susp_node, "snd_make_gate"); + susp->rise_time = signal->sr * risetime + 0.5; + susp->fall_time = signal->sr * falltime + 0.5; + susp->floor = floor; floor = log(floor);; + susp->threshold = threshold; + susp->on_count = 0; + susp->off_count = 0; + susp->rise_factor = exp(- floor / susp->rise_time); + susp->fall_factor = exp(floor / susp->fall_time); + susp->start_fall = 0; + susp->start_rise = 0; + susp->stop_count = 0; + susp->delay_len = max(1, round(signal->sr * lookahead)); + susp->state = ST_OFF; + susp->value = susp->floor; + susp->susp.fetch = gate_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < signal->t0) sound_prepend_zeros(signal, t0); + /* minimum start time over all inputs: */ + t0_min = min(signal->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 = gate_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = gate_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = gate_mark; + susp->susp.print_tree = gate_print_tree; + susp->susp.name = "gate"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->signal = signal; + susp->signal_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_gate(sound_type signal, time_type lookahead, double risetime, double falltime, double floor, double threshold) +{ + sound_type signal_copy = sound_copy(signal); + return snd_make_gate(signal_copy, lookahead, risetime, falltime, floor, threshold); +} diff --git a/tran/gate.h b/tran/gate.h new file mode 100644 index 0000000..851c783 --- /dev/null +++ b/tran/gate.h @@ -0,0 +1,3 @@ +sound_type snd_make_gate(sound_type signal, time_type lookahead, double risetime, double falltime, double floor, double threshold); +sound_type snd_gate(sound_type signal, time_type lookahead, double risetime, double falltime, double floor, double threshold); + /* LISP: (snd-gate SOUND ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/ifft-old.alg b/tran/ifft-old.alg new file mode 100644 index 0000000..442be85 --- /dev/null +++ b/tran/ifft-old.alg @@ -0,0 +1,92 @@ +(IFFT-ALG + (NAME "ifft") + (ARGUMENTS ("time_type" "t0") ("rate_type" "sr") ("LVAL" "src")) + (SUPPORT-FUNCTIONS " +/* IMPLEMENTATION NOTE: + * The src argument is an XLisp object that returns either an + * array of samples or NIL. The output of ifft is simply the + * concatenation of the samples taken from the array. Later, + * an ifft will be plugged in and this will return overlapped + * adds of the ifft's. + */ + +#include \"samples.h\" + + /* IFFT code goes here */ +") + + (SAMPLE-RATE "sr") + (STATE + ("long" "index" "0") ; samples index + ("long" "length" "0"); samples length + ("LVAL" "array" "NULL") + ("LVAL" "src" "src") + ("sample_type *" "samples" "NULL")) + + (OUTER-LOOP " + if (susp->src == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + if (susp->index >= susp->length) { + long i; + susp->index = 0; + susp->array = xleval(cons(s_send, cons(susp->src, consa(s_next)))); + susp->index = 0; + if (susp->array == NULL) { + susp->src = NULL; + goto out; + } else if (!vectorp(susp->array)) { + xlerror(\"array expected\", susp->array); + } else if (susp->samples == NULL) { + /* assume arrays are all the same size as first one; + now that we know the size, we just have to do this + first allocation. + */ + susp->length = getsize(susp->array); + if (susp->length < 1) xlerror(\"array has no elements\", susp->array); + susp->samples = + (sample_type *) calloc(susp->length, + sizeof(sample_type)); + } else if (getsize(susp->array) != susp->length) { + xlerror(\"arrays must all be the same length\", susp->array); + } + /* at this point, we have a new array and a place to put samples */ + for (i = 0; i < susp->length; i++) { + LVAL elem = getelement(susp->array, i); + if (ntype(elem) != FLONUM) { + xlerror(\"flonum expected\", elem); + } + susp->samples[i] = (sample_type) getflonum(elem); + } + susp->array = NULL; /* free the array */ + /* here is where the IFFT and windowing should take place */ +/* + temp_fft = (double *) malloc (susp->length * sizeof(double)); + if (temp_fft == 0) return; + big_samples = (double *) malloc (susp->length * sizeof(double)); + if (big_samples == 0) return; + for (i = 0; i < susp->length; i++) { + big_samples[i] = (double) susp->samples[i]; + } + rp = rfftw_create_plan(susp->length, FFTW_COMPLEX_TO_REAL, FFTW_ESTIMATE); + rfftw_one(rp, big_samples, temp_fft); + rfftw_destroy_plan(rp); + free(big_samples); + for (i = 0; i < susp->length; i++) { + setelement(result, i, cvflonum(temp_fft[i])); + } + free (temp_fft); +*/ + + } + togo = min(togo, susp->length - susp->index); +") + (INNER-LOOP "output = samples[index++];") + (CONSTANT "length" "samples" "array" "src") + (TERMINATE COMPUTED) + (FINALIZATION " free(susp->samples); +") + +) + diff --git a/tran/ifft.alg b/tran/ifft.alg new file mode 100644 index 0000000..c634351 --- /dev/null +++ b/tran/ifft.alg @@ -0,0 +1,182 @@ +(IFFT-ALG + (NAME "ifft") + (ARGUMENTS ("time_type" "t0") ("rate_type" "sr") + ("LVAL" "src") ("long" "stepsize") + ("LVAL" "window")) + (SUPPORT-FUNCTIONS " +/* index: index into outbuf whree we get output samples + * length: size of the frame, window, and outbuf; half size of samples + * array: spectral frame goes here (why not a local var?) + * window_len: size of window, should equal length + * outbuf: real part of samples are multiplied by window and added to + * outbuf (after shifting) + * src: send :NEXT to this object to get next frame + * stepsize: shift by this many and add each frame + * samples: result of ifft goes here, real and imag + * window: multiply samples by window if any + * + * IMPLEMENTATION NOTE: + * The src argument is an XLisp object that returns either an + * array of samples or NIL. The output of ifft is simply the + * concatenation of the samples taken from the array. Later, + * an ifft will be plugged in and this will return overlapped + * adds of the ifft's. + * + * OVERLAP: stepsize must be less than or equal to the length + * of real part of the transformed spectrum. A transform step + * works like this: + * (1) shift the output buffer by stepsize samples, filling + * the end of the buffer with zeros + * (2) get and transform an array of spectral coefficients + * (3) multiply the result by a window + * (4) add the result to the output buffer + * (5) output the first stepsize samples of the buffer + * + * DATA FORMAT: the DC component goes in array elem 0 + * Cosine part is in elements 2*i-1 + * Sine part is in elements 2*i + * Nyquist frequency is in element length-1 + */ + +#include \"samples.h\" +#include \"fftext.h\" + +#define MUST_BE_FLONUM(e) \\ + if (!(e) || ntype(e) != FLONUM) { xlerror(\"flonum expected\", (e)); } + +table_type get_window_samples(LVAL window, sample_type **samples, long *len) +{ + table_type result = NULL; + if (soundp(window)) { + sound_type window_sound = getsound(window); + xlprot1(window); /* maybe not necessary */ + result = sound_to_table(window_sound); + xlpop(); + *samples = result->samples; + *len = (long) (result->length + 0.5); + } + return result; +} +") + + (SAMPLE-RATE "sr") + (STATE + ("long" "index" "stepsize") ; samples index + ("long" "length" "0") ; samples length + ("LVAL" "array" "NULL") + ("long" "window_len" "0") + ("sample_type *" "outbuf" "NULL") + ("LVAL" "src" "src") + ("long" "stepsize" "stepsize") + ("sample_type *" "window" "NULL") ; window samples + ("sample_type *" "samples" "NULL") + ("table_type" "table" + "get_window_samples(window, &susp->window, &susp->window_len)")) + + (OUTER-LOOP " + if (susp->src == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + if (susp->index >= susp->stepsize) { + long i; + long m, n; + LVAL elem; + susp->index = 0; + susp->array = + xleval(cons(s_send, cons(susp->src, consa(s_next)))); + if (susp->array == NULL) { + susp->src = NULL; + goto out; + } else if (!vectorp(susp->array)) { + xlerror(\"array expected\", susp->array); + } else if (susp->samples == NULL) { + /* assume arrays are all the same size as first one; + now that we know the size, we just have to do this + first allocation. + */ + susp->length = getsize(susp->array); + if (susp->length < 1) + xlerror(\"array has no elements\", susp->array); + if (susp->window && (susp->window_len != susp->length)) + xlerror(\"window size and spectrum size differ\", + susp->array); + /* tricky non-power of 2 detector: only if this is a + * power of 2 will the highest 1 bit be cleared when + * we subtract 1 ... + */ + if (susp->length & (susp->length - 1)) + xlfail(\"spectrum size must be a power of 2\"); + susp->samples = (sample_type *) calloc(susp->length, + sizeof(sample_type)); + susp->outbuf = (sample_type *) calloc(susp->length, + sizeof(sample_type)); + } else if (getsize(susp->array) != susp->length) { + xlerror(\"arrays must all be the same length\", susp->array); + } + + /* at this point, we have a new array to put samples */ + /* the incoming array format is [DC, R1, I1, R2, I2, ... RN] + * where RN is the real coef at the Nyquist frequency + * but susp->samples should be organized as [DC, RN, R1, I1, ...] + */ + n = susp->length; + /* get the DC (real) coef */ + elem = getelement(susp->array, 0); + MUST_BE_FLONUM(elem) + susp->samples[0] = (sample_type) getflonum(elem); + + /* get the Nyquist (real) coef */ + elem = getelement(susp->array, n - 1); + MUST_BE_FLONUM(elem); + susp->samples[1] = (sample_type) getflonum(elem); + + /* get the remaining coef */ + for (i = 1; i < n - 1; i++) { + elem = getelement(susp->array, i); + MUST_BE_FLONUM(elem) + susp->samples[i + 1] = (sample_type) getflonum(elem); + } + susp->array = NULL; /* free the array */ + + /* here is where the IFFT and windowing should take place */ + //fftnf(1, &n, susp->samples, susp->samples + n, -1, 1.0); + m = round(log2(n)); + if (!fftInit(m)) riffts(susp->samples, m, 1); + else xlfail(\"FFT initialization error\"); + if (susp->window) { + n = susp->length; + for (i = 0; i < n; i++) { + susp->samples[i] *= susp->window[i]; + } + } + + /* shift the outbuf */ + n = susp->length - susp->stepsize; + for (i = 0; i < n; i++) { + susp->outbuf[i] = susp->outbuf[i + susp->stepsize]; + } + + /* clear end of outbuf */ + for (i = n; i < susp->length; i++) { + susp->outbuf[i] = 0; + } + + /* add in the ifft result */ + n = susp->length; + for (i = 0; i < n; i++) { + susp->outbuf[i] += susp->samples[i]; + } + } + togo = min(togo, susp->stepsize - susp->index); +") + (INNER-LOOP "output = outbuf[index++];") + (CONSTANT "length" "samples" "array" "src" "window") + (TERMINATE COMPUTED) + (FINALIZATION " if (susp->samples) free(susp->samples); + if (susp->table) table_unref(susp->table); + if (susp->outbuf) free(susp->outbuf); +") + +) + diff --git a/tran/ifft.c b/tran/ifft.c new file mode 100644 index 0000000..3165f15 --- /dev/null +++ b/tran/ifft.c @@ -0,0 +1,286 @@ +#include "stdio.h" +#define _USE_MATH_DEFINES 1 /* for Visual C++ to get M_LN2 */ +#include <math.h> +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "ifft.h" + +void ifft_free(); + + +typedef struct ifft_susp_struct { + snd_susp_node susp; + + long index; + long length; + LVAL array; + long window_len; + sample_type *outbuf; + LVAL src; + long stepsize; + sample_type *window; + sample_type *samples; + table_type table; +} ifft_susp_node, *ifft_susp_type; + + +/* index: index into outbuf whree we get output samples + * length: size of the frame, window, and outbuf; half size of samples + * array: spectral frame goes here (why not a local var?) + * window_len: size of window, should equal length + * outbuf: real part of samples are multiplied by window and added to + * outbuf (after shifting) + * src: send :NEXT to this object to get next frame + * stepsize: shift by this many and add each frame + * samples: result of ifft goes here, real and imag + * window: multiply samples by window if any + * + * IMPLEMENTATION NOTE: + * The src argument is an XLisp object that returns either an + * array of samples or NIL. The output of ifft is simply the + * concatenation of the samples taken from the array. Later, + * an ifft will be plugged in and this will return overlapped + * adds of the ifft's. + * + * OVERLAP: stepsize must be less than or equal to the length + * of real part of the transformed spectrum. A transform step + * works like this: + * (1) shift the output buffer by stepsize samples, filling + * the end of the buffer with zeros + * (2) get and transform an array of spectral coefficients + * (3) multiply the result by a window + * (4) add the result to the output buffer + * (5) output the first stepsize samples of the buffer + * + * DATA FORMAT: the DC component goes in array elem 0 + * Cosine part is in elements 2*i-1 + * Sine part is in elements 2*i + * Nyquist frequency is in element length-1 + */ + +#include "samples.h" +#include "fftext.h" + +#define MUST_BE_FLONUM(e) \ + if (!(e) || ntype(e) != FLONUM) { xlerror("flonum expected", (e)); } + +table_type get_window_samples(LVAL window, sample_type **samples, long *len) +{ + table_type result = NULL; + if (soundp(window)) { + sound_type window_sound = getsound(window); + xlprot1(window); /* maybe not necessary */ + result = sound_to_table(window_sound); + xlpop(); + *samples = result->samples; + *len = (long) (result->length + 0.5); + } + return result; +} + + +void ifft__fetch(register ifft_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 long index_reg; + register sample_type * outbuf_reg; + falloc_sample_block(out, "ifft__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; + + + if (susp->src == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + if (susp->index >= susp->stepsize) { + long i; + long m, n; + LVAL elem; + susp->index = 0; + susp->array = + xleval(cons(s_send, cons(susp->src, consa(s_next)))); + if (susp->array == NULL) { + susp->src = NULL; + goto out; + } else if (!vectorp(susp->array)) { + xlerror("array expected", susp->array); + } else if (susp->samples == NULL) { + /* assume arrays are all the same size as first one; + now that we know the size, we just have to do this + first allocation. + */ + susp->length = getsize(susp->array); + if (susp->length < 1) + xlerror("array has no elements", susp->array); + if (susp->window && (susp->window_len != susp->length)) + xlerror("window size and spectrum size differ", + susp->array); + /* tricky non-power of 2 detector: only if this is a + * power of 2 will the highest 1 bit be cleared when + * we subtract 1 ... + */ + if (susp->length & (susp->length - 1)) + xlfail("spectrum size must be a power of 2"); + susp->samples = (sample_type *) calloc(susp->length, + sizeof(sample_type)); + susp->outbuf = (sample_type *) calloc(susp->length, + sizeof(sample_type)); + } else if (getsize(susp->array) != susp->length) { + xlerror("arrays must all be the same length", susp->array); + } + + /* at this point, we have a new array to put samples */ + /* the incoming array format is [DC, R1, I1, R2, I2, ... RN] + * where RN is the real coef at the Nyquist frequency + * but susp->samples should be organized as [DC, RN, R1, I1, ...] + */ + n = susp->length; + /* get the DC (real) coef */ + elem = getelement(susp->array, 0); + MUST_BE_FLONUM(elem) + susp->samples[0] = (sample_type) getflonum(elem); + + /* get the Nyquist (real) coef */ + elem = getelement(susp->array, n - 1); + MUST_BE_FLONUM(elem); + susp->samples[1] = (sample_type) getflonum(elem); + + /* get the remaining coef */ + for (i = 1; i < n - 1; i++) { + elem = getelement(susp->array, i); + MUST_BE_FLONUM(elem) + susp->samples[i + 1] = (sample_type) getflonum(elem); + } + susp->array = NULL; /* free the array */ + + /* here is where the IFFT and windowing should take place */ + //fftnf(1, &n, susp->samples, susp->samples + n, -1, 1.0); + m = round(log(n) / M_LN2); + if (!fftInit(m)) riffts(susp->samples, m, 1); + else xlfail("FFT initialization error"); + if (susp->window) { + n = susp->length; + for (i = 0; i < n; i++) { + susp->samples[i] *= susp->window[i]; + } + } + + /* shift the outbuf */ + n = susp->length - susp->stepsize; + for (i = 0; i < n; i++) { + susp->outbuf[i] = susp->outbuf[i + susp->stepsize]; + } + + /* clear end of outbuf */ + for (i = n; i < susp->length; i++) { + susp->outbuf[i] = 0; + } + + /* add in the ifft result */ + n = susp->length; + for (i = 0; i < n; i++) { + susp->outbuf[i] += susp->samples[i]; + } + } + togo = min(togo, susp->stepsize - susp->index); + + n = togo; + index_reg = susp->index; + outbuf_reg = susp->outbuf; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = outbuf_reg[index_reg++];; + } while (--n); /* inner loop */ + + susp->index = index_reg; + susp->outbuf = outbuf_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; + } +} /* ifft__fetch */ + + +void ifft_mark(ifft_susp_type susp) +{ + if (susp->src) mark(susp->src); + if (susp->array) mark(susp->array); +} + + +void ifft_free(ifft_susp_type susp) +{ + if (susp->samples) free(susp->samples); + if (susp->table) table_unref(susp->table); + if (susp->outbuf) free(susp->outbuf); + ffree_generic(susp, sizeof(ifft_susp_node), "ifft_free"); +} + + +void ifft_print_tree(ifft_susp_type susp, int n) +{ +} + + +sound_type snd_make_ifft(time_type t0, rate_type sr, LVAL src, long stepsize, LVAL window) +{ + register ifft_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, ifft_susp_node, "snd_make_ifft"); + susp->index = stepsize; + susp->length = 0; + susp->array = NULL; + susp->window_len = 0; + susp->outbuf = NULL; + susp->src = src; + susp->stepsize = stepsize; + susp->window = NULL; + susp->samples = NULL; + susp->table = get_window_samples(window, &susp->window, &susp->window_len); + susp->susp.fetch = ifft__fetch; + + /* initialize susp state */ + susp->susp.free = ifft_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = ifft_mark; + susp->susp.print_tree = ifft_print_tree; + susp->susp.name = "ifft"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_ifft(time_type t0, rate_type sr, LVAL src, long stepsize, LVAL window) +{ + return snd_make_ifft(t0, sr, src, stepsize, window); +} diff --git a/tran/ifft.h b/tran/ifft.h new file mode 100644 index 0000000..186cec6 --- /dev/null +++ b/tran/ifft.h @@ -0,0 +1,3 @@ +sound_type snd_make_ifft(time_type t0, rate_type sr, LVAL src, long stepsize, LVAL window); +sound_type snd_ifft(time_type t0, rate_type sr, LVAL src, long stepsize, LVAL window); + /* LISP: (snd-ifft ANYNUM ANYNUM ANY FIXNUM ANY) */ diff --git a/tran/init.lsp b/tran/init.lsp new file mode 100644 index 0000000..ac49ca1 --- /dev/null +++ b/tran/init.lsp @@ -0,0 +1,24 @@ +(expand 50) + +(load "../runtime/xlinit.lsp") + +(load "../runtime/misc.lsp") + +;; set to T to get interpolation within inner loops +(setf *INLINE-INTERPOLATION* nil) + +;; set to T to get ANSI headers and NIL to get antique headers +(setf *ANSI* NIL) + +;; set to T to generate tracing code, NIL to disable tracing code +(setf *WATCH* NIL) + +(load "translate") +(load "writesusp") +(load "writemake") +(load "writetoss") +(load "innerloop") + +(setf *gc-flag* t) + +(setf *watch* nil) diff --git a/tran/innerloop.lsp b/tran/innerloop.lsp new file mode 100644 index 0000000..7d914aa --- /dev/null +++ b/tran/innerloop.lsp @@ -0,0 +1,311 @@ +;; innerloop.lsp -- code to generate inner loops from specs + +;; the inner loop has a setup, a loop, and a cleanup +;; in the setup, structure fields used in the inner loop are +;; copied or "cached" into register variables +;; in the inner loop, access expressions are substituted for +;; variable names in the spec +;; in the cleanup, resulting register variable "cache" is copied +;; back into the structure fields + + +(defun compute-inner-loop (alg inner-loop) + (let ((interp (get-slot alg 'interpolation)) + (sound-names (get alg 'sound-names)) + (state-list (get-slot alg 'state)) + (step-function (get alg 'step-function)) + (maintain-list (get-slot alg 'maintain)) + (constant-list (get-slot alg 'constant)) + (force-into-register (get-slot alg 'force-into-register)) + (not-register (get-slot alg 'not-register)) + register-decl register-init register-cleanup new-state-list + ) + + ;; this loop computes and applies substitutions to the INNER-LOOP spec + + (setf inner-loop (substitute inner-loop "output" "*out_ptr_reg++" nil)) + (push "\tout_ptr_reg = out_ptr;\n" register-init) + (push "\tout_ptr += togo;\n" register-cleanup) + + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + interpolate-samples + (method (nth n interp)) + expression) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + + (cond ((eq method 'NONE) + ;----------------- + ; NONE: + ; <expr> ::= *NAME_ptr_reg++ + ;----------------- + (pushnew (format nil + " register sample_block_values_type ~A_ptr_reg;~%" name) + register-decl) + (pushnew (format nil + "\t~A_ptr_reg = susp->~A_ptr;~%" name name) + register-init) + (pushnew (format nil + "\t/* using ~A_ptr_reg is a bad idea on RS/6000: */~ + ~%\tsusp->~A_ptr += togo;~%" name name name) + register-cleanup) + + (setf expression (format nil "*~A_ptr_reg++" name))) + + ((eq method 'SCALE) + ;----------------- + ; SCALE + ; <expr> ::= (NAME_scale_reg * *NAME_ptr_reg++) + ;----------------- + (pushnew (format nil + " register sample_block_values_type ~A_ptr_reg;~%" name) + register-decl) + (pushnew (format nil + " register sample_type ~A_scale_reg = susp->~A->scale;~%" name name) + register-decl) + (pushnew (format nil + "\t~A_ptr_reg = susp->~A_ptr;~%" name name) + register-init) + (pushnew (format nil + "\t/* using ~A_ptr_reg is a bad idea on RS/6000: */~ + ~%\tsusp->~A_ptr += togo;~%" name name name) + register-cleanup) + (setf expression (format nil + "(~A_scale_reg * *~A_ptr_reg++)" name name))) + + ((and interpolate-samples (eq method 'INTERP)) + ;----------------- + ; INTERP: + ; <expr> ::= susp->NAME_x1_sample * (1 - + ; susp->NAME_pHaSe + + ; susp->NAME_x2_sample * susp->NAME_pHaSe) + ;----------------- + (pushnew (format nil + " register sample_type ~A_x1_sample_reg;~%" name) + register-decl) + (pushnew (format nil + " register double ~A_pHaSe_ReG;~%" name) + register-decl) + (pushnew (format nil + " register double ~A_pHaSe_iNcR_rEg = susp->~A_pHaSe_iNcR;~%" name name) + register-decl) + + (pushnew (format nil + "\t~A_x1_sample_reg = susp->~A_x1_sample;~%" name name) + register-init) + (pushnew (format nil + "\t~A_pHaSe_ReG = susp->~A_pHaSe;~%" name name) + register-init) + + (pushnew (format nil + "\tsusp->~A_x1_sample = ~A_x1_sample_reg;~%" name name) + register-cleanup) + (pushnew (format nil + "\tsusp->~A_pHaSe = ~A_pHaSe_ReG;~%" name name) + register-cleanup) + + (setf expression (format nil + "\n\t\t(~A_x1_sample_reg * (1 - ~A_pHaSe_ReG) + ~A_x2_sample * ~A_pHaSe_ReG)" + name name name name))) + + ((eq method 'INTERP) + ;----------------- + ; STEP FUNCTION: + ; <expr> ::= NAME_x1_sample_reg + ;----------------- + (pushnew (format nil + " register sample_type ~A_x1_sample_reg;~%" name) + register-decl) + (pushnew (format nil + " register double ~A_pHaSe_ReG;~%" name) + register-decl) + (pushnew (format nil + " register double ~A_pHaSe_iNcR_rEg = susp->~A_pHaSe_iNcR;~%" name name) + register-decl) + + (pushnew (format nil + "\t~A_x1_sample_reg = susp->~A_x1_sample;~%" name name) + register-init) + (pushnew (format nil + "\t~A_pHaSe_ReG = susp->~A_pHaSe;~%" name name) + register-init) + + (pushnew (format nil + "\tsusp->~A_x1_sample = ~A_x1_sample_reg;~%" name name) + register-cleanup) + (pushnew (format nil + "\tsusp->~A_pHaSe = ~A_pHaSe_ReG;~%" name name) + register-cleanup) + + (setf expression (format nil "~A_x1_sample_reg" name))) + ((and interpolate-samples (eq method 'RAMP)) + ;----------------- + ; RAMP: + ; <expr> ::= NAME_val + ;----------------- + (setf expression (format nil "~A_val" name))) + ((eq method 'RAMP) + ;----------------- + ; RAMP: + ; <expr> ::= NAME_val + ;----------------- + ; this doesn't seem to be used -RBD 7/97 + ;(pushnew (format nil + ;" register sample_type ~A_x1_sample_reg;~%" name) + ;register-decl) + (setf expression (format nil "~A_val" name)))) + + (setf inner-loop (substitute inner-loop name expression nil)) + )) + + ;; determine the members of state-list that are actually referenced in + ;; the inner loop. If not, don't cache the state in registers before + ;; starting the loop. + (dolist (state state-list) + (let ((var-name (cadr state))) + (cond ((and (or (string-search var-name inner-loop) + (member (name-to-symbol var-name) force-into-register)) + (not (member (name-to-symbol var-name) not-register))) + (push state new-state-list))))) + + ;; this loop applies substitutions for state variables: + ;; the specified state variable name is the cadr of state-list element + ;; the state variable <var> is replaced in inner-loop by <var>_reg + + (dolist (state new-state-list) + (let ((var-name (cadr state)) + maintain) + (pushnew (format nil " register ~A ~A_reg;~%" (car state) var-name) + register-decl) + (pushnew (format nil "\t~A_reg = susp->~A;~%" var-name var-name) + register-init) + (setf maintain (find-maintain-stmt var-name maintain-list)) +; (display "find-maintain-stmt returned:" maintain) + (cond (maintain + (pushnew (format nil "\t~A;~%" maintain) register-cleanup)) + ((not (is-constant-in-inner-loop var-name constant-list)) + ;(pushnew (format nil "var-name: ~A constant-list: ~A~%" var-name constant-list) + ; register-cleanup) + (pushnew (format nil "\tsusp->~A = ~A_reg;~%" var-name var-name) + register-cleanup))) + (setf inner-loop (substitute inner-loop var-name + (format nil "~A_reg" var-name) t)) + )) + + ;(display "register decls" state-list register-decl) (read) + + ;; if the user-written code has a break statement or if the interpolation + ;; type is INTERP, we need to write out "togo -= n;" to get an accurate + ;; count of how many times we went through the loop. Otherwise don't do it + ;; because it makes n a live variable and affects compiler optimization. + (cond ((or (member 'INTERP interp) + (string-search "break" inner-loop)) + (push "\ttogo -= n;\n" register-cleanup))) + + (put-slot alg inner-loop 'inner-loop-stmts) + (put-slot alg register-decl 'register-decl) + (put-slot alg register-init 'register-init) + (put-slot alg register-cleanup 'register-cleanup) + + ;----------------- + ; WATCH: + ; + ; show_samples(1,s1,s1_ptr - s1->samples) + ; + ; Note: this is not right because we need to have the correct + ; parameter for s1, but that is part of the s1_ptr++ computation + ; so I don't know where to get it... + ;----------------- +; (if *WATCH* +; (format stream "\t show_samples(1,s1,s1_ptr - s1_samples);~%") +; ) + )) + + +;; find-maintain-list -- find an assignment for variable in a MAINTAIN spec +;; +(defun find-maintain-stmt (var specs) + (let ((spec (assoc var specs :test #'equal))) + (if spec (cadr spec)))) + + +;; is-constant-in-inner-loop -- see if var is in constant-list +;; +(defun is-constant-in-inner-loop (var constant-list) + (member var constant-list :test #'equal)) + + +;; pushnew -- pushes string onto list unless already there +;; +(defmacro pushnew (string var) + `(if (not (member ,string ,var :test #'equal)) + (push ,string ,var))) + + +;;********** +;; substitute -- string substitution +;; Inputs: +;; s - input string +;; pat - pattern +;; repl - replacement for pattern +;; all - T or NIL (T : replace everywhere; NIL : replace once) +;; +;;********** + +(defun substitute (s pat repl all) +; (display "substitute" s pat repl) + (let ((p (position s pat)) + (l (length pat))) + (cond (p + (strcat (subseq s 0 p) repl + ;; the remainder of the string depends on all. If T, then + ;; use recursion to continue substitutions: + (cond (all (substitute (subseq s (+ p l)) pat repl all)) + (t (subseq s (+ p l)))))) + (t s)))) + + +(defun write-inner-loop (alg stream) + (let ((interp (get-slot alg 'interpolation)) + (step-function (get alg 'step-function)) + (sound-names (get alg 'sound-names)) + ) + + (format stream "~A;~%" + (get-slot alg 'inner-loop-stmts)) + + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + interpolate-samples + (method (nth n interp))) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + + (cond ((eq method 'INTERP) + ;----------------- + ; INTERP: + ; + ; NAME_pHaSe_ReG += NAME_pHaSe_iNcR_rEg; + ;----------------- + (format stream "\t ~A_pHaSe_ReG += ~A_pHaSe_iNcR_rEg;~%" + name name)) + + ((and interpolate-samples (eq method 'RAMP)) + ;----------------- + ; RAMP: + ; NAME_val += NAME_DeLtA + ;----------------- + (format stream "\t ~A_val += ~A_DeLtA;~%" name name))))) + + ;---------------------------- + ; WATCH: + ; show_samples(0,out,out_ptr - 1 - out->samples); + ;---------------------------- + +; (if *WATCH* +; (format stream "\t show_samples(0,out,out_ptr - 1 - out->samples);~%")) + ;---------------------------- + ; } while (--n); /* inner loop */ + ;---------------------------- + (format stream "\t} while (--n); /* inner loop */~%~%"))) diff --git a/tran/instrbanded.alg b/tran/instrbanded.alg new file mode 100644 index 0000000..49345d9 --- /dev/null +++ b/tran/instrbanded.alg @@ -0,0 +1,24 @@ +(INSTRBANDED-ALG +(NAME "bandedwg") +(ARGUMENTS ("double" "freq") ("sound_type" "bowpress_env") ("int" "preset")("rate_type" "sr")) +(STATE ("struct instr *" "mybanded" "initInstrument(BANDEDWG, round(sr)); + controlChange(susp->mybanded, 16, preset);") + ("int" "temp_ret_value" "noteOn(susp->mybanded, freq, 1.0)")) +(START (min bowpress_env)) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value" "preset") +(SAMPLE-RATE "sr") +(ALWAYS-SCALE bowpress_env) +(TERMINATE (min bowpress_env)) +(INNER-LOOP " + controlChange(mybanded, 2, BANDEDWG_CONTROL_CHANGE_CONST * bowpress_env); + output = (sample_type) tick(mybanded)") +(SUPPORT-HEADER " + #define BANDEDWG_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->mybanded); +") +) diff --git a/tran/instrbanded.c b/tran/instrbanded.c new file mode 100644 index 0000000..585bcfc --- /dev/null +++ b/tran/instrbanded.c @@ -0,0 +1,181 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrbanded.h" + +void bandedwg_free(); + + +typedef struct bandedwg_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type bowpress_env; + long bowpress_env_cnt; + sample_block_values_type bowpress_env_ptr; + + struct instr *mybanded; + int temp_ret_value; +} bandedwg_susp_node, *bandedwg_susp_type; + + + #include "instr.h" + + +void bandedwg_s_fetch(register bandedwg_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 struct instr * mybanded_reg; + register sample_type bowpress_env_scale_reg = susp->bowpress_env->scale; + register sample_block_values_type bowpress_env_ptr_reg; + falloc_sample_block(out, "bandedwg_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 bowpress_env input sample block: */ + susp_check_term_samples(bowpress_env, bowpress_env_ptr, bowpress_env_cnt); + togo = min(togo, susp->bowpress_env_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; + mybanded_reg = susp->mybanded; + bowpress_env_ptr_reg = susp->bowpress_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(mybanded_reg, 2, BANDEDWG_CONTROL_CHANGE_CONST * (bowpress_env_scale_reg * *bowpress_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(mybanded_reg); + } while (--n); /* inner loop */ + + susp->mybanded = mybanded_reg; + /* using bowpress_env_ptr_reg is a bad idea on RS/6000: */ + susp->bowpress_env_ptr += togo; + out_ptr += togo; + susp_took(bowpress_env_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; + } +} /* bandedwg_s_fetch */ + + +void bandedwg_toss_fetch(susp, snd_list) + register bandedwg_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from bowpress_env up to final_time for this block of zeros */ + while ((round((final_time - susp->bowpress_env->t0) * susp->bowpress_env->sr)) >= + susp->bowpress_env->current) + susp_get_samples(bowpress_env, bowpress_env_ptr, bowpress_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->bowpress_env->t0) * susp->bowpress_env->sr - + (susp->bowpress_env->current - susp->bowpress_env_cnt)); + susp->bowpress_env_ptr += n; + susp_took(bowpress_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void bandedwg_mark(bandedwg_susp_type susp) +{ + sound_xlmark(susp->bowpress_env); +} + + +void bandedwg_free(bandedwg_susp_type susp) +{ + + deleteInstrument(susp->mybanded); + sound_unref(susp->bowpress_env); + ffree_generic(susp, sizeof(bandedwg_susp_node), "bandedwg_free"); +} + + +void bandedwg_print_tree(bandedwg_susp_type susp, int n) +{ + indent(n); + stdputstr("bowpress_env:"); + sound_print_tree_1(susp->bowpress_env, n); +} + + +sound_type snd_make_bandedwg(double freq, sound_type bowpress_env, int preset, rate_type sr) +{ + register bandedwg_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = bowpress_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, bandedwg_susp_node, "snd_make_bandedwg"); + susp->mybanded = initInstrument(BANDEDWG, round(sr)); + controlChange(susp->mybanded, 16, preset);; + susp->temp_ret_value = noteOn(susp->mybanded, freq, 1.0); + susp->susp.fetch = bandedwg_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < bowpress_env->t0) sound_prepend_zeros(bowpress_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(bowpress_env->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 = bandedwg_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = bandedwg_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = bandedwg_mark; + susp->susp.print_tree = bandedwg_print_tree; + susp->susp.name = "bandedwg"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->bowpress_env = bowpress_env; + susp->bowpress_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_bandedwg(double freq, sound_type bowpress_env, int preset, rate_type sr) +{ + sound_type bowpress_env_copy = sound_copy(bowpress_env); + return snd_make_bandedwg(freq, bowpress_env_copy, preset, sr); +} diff --git a/tran/instrbanded.h b/tran/instrbanded.h new file mode 100644 index 0000000..f582d9e --- /dev/null +++ b/tran/instrbanded.h @@ -0,0 +1,5 @@ +sound_type snd_make_bandedwg(double freq, sound_type bowpress_env, int preset, rate_type sr); +sound_type snd_bandedwg(double freq, sound_type bowpress_env, int preset, rate_type sr); + /* LISP: (snd-bandedwg ANYNUM SOUND FIXNUM ANYNUM) */ + + #define BANDEDWG_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrbow.alg b/tran/instrbow.alg new file mode 100644 index 0000000..315eb54 --- /dev/null +++ b/tran/instrbow.alg @@ -0,0 +1,25 @@ +(INSTRBOW-ALG +(NAME "bowed") +(ARGUMENTS ("double" "freq") ("sound_type" "bowpress_env") ("rate_type" "sr")) +(STATE ("struct instr *" "mybow" "initInstrument(BOWED, round(sr)); + controlChange(susp->mybow, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->mybow, freq, 1.0)")) +(START (min bowpress_env)) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value") +(SAMPLE-RATE "sr") +(ALWAYS-SCALE bowpress_env) +(TERMINATE (min bowpress_env)) +(INNER-LOOP " + controlChange(mybow, 128, BOW_CONTROL_CHANGE_CONST * bowpress_env); + output = (sample_type) tick(mybow)") +(SUPPORT-HEADER " + #define BOW_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->mybow); +") +) + diff --git a/tran/instrbow.c b/tran/instrbow.c new file mode 100644 index 0000000..b9cc841 --- /dev/null +++ b/tran/instrbow.c @@ -0,0 +1,181 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrbow.h" + +void bowed_free(); + + +typedef struct bowed_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type bowpress_env; + long bowpress_env_cnt; + sample_block_values_type bowpress_env_ptr; + + struct instr *mybow; + int temp_ret_value; +} bowed_susp_node, *bowed_susp_type; + + + #include "instr.h" + + +void bowed_s_fetch(register bowed_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 struct instr * mybow_reg; + register sample_type bowpress_env_scale_reg = susp->bowpress_env->scale; + register sample_block_values_type bowpress_env_ptr_reg; + falloc_sample_block(out, "bowed_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 bowpress_env input sample block: */ + susp_check_term_samples(bowpress_env, bowpress_env_ptr, bowpress_env_cnt); + togo = min(togo, susp->bowpress_env_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; + mybow_reg = susp->mybow; + bowpress_env_ptr_reg = susp->bowpress_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(mybow_reg, 128, BOW_CONTROL_CHANGE_CONST * (bowpress_env_scale_reg * *bowpress_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(mybow_reg); + } while (--n); /* inner loop */ + + susp->mybow = mybow_reg; + /* using bowpress_env_ptr_reg is a bad idea on RS/6000: */ + susp->bowpress_env_ptr += togo; + out_ptr += togo; + susp_took(bowpress_env_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; + } +} /* bowed_s_fetch */ + + +void bowed_toss_fetch(susp, snd_list) + register bowed_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from bowpress_env up to final_time for this block of zeros */ + while ((round((final_time - susp->bowpress_env->t0) * susp->bowpress_env->sr)) >= + susp->bowpress_env->current) + susp_get_samples(bowpress_env, bowpress_env_ptr, bowpress_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->bowpress_env->t0) * susp->bowpress_env->sr - + (susp->bowpress_env->current - susp->bowpress_env_cnt)); + susp->bowpress_env_ptr += n; + susp_took(bowpress_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void bowed_mark(bowed_susp_type susp) +{ + sound_xlmark(susp->bowpress_env); +} + + +void bowed_free(bowed_susp_type susp) +{ + + deleteInstrument(susp->mybow); + sound_unref(susp->bowpress_env); + ffree_generic(susp, sizeof(bowed_susp_node), "bowed_free"); +} + + +void bowed_print_tree(bowed_susp_type susp, int n) +{ + indent(n); + stdputstr("bowpress_env:"); + sound_print_tree_1(susp->bowpress_env, n); +} + + +sound_type snd_make_bowed(double freq, sound_type bowpress_env, rate_type sr) +{ + register bowed_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = bowpress_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, bowed_susp_node, "snd_make_bowed"); + susp->mybow = initInstrument(BOWED, round(sr)); + controlChange(susp->mybow, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->mybow, freq, 1.0); + susp->susp.fetch = bowed_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < bowpress_env->t0) sound_prepend_zeros(bowpress_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(bowpress_env->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 = bowed_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = bowed_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = bowed_mark; + susp->susp.print_tree = bowed_print_tree; + susp->susp.name = "bowed"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->bowpress_env = bowpress_env; + susp->bowpress_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_bowed(double freq, sound_type bowpress_env, rate_type sr) +{ + sound_type bowpress_env_copy = sound_copy(bowpress_env); + return snd_make_bowed(freq, bowpress_env_copy, sr); +} diff --git a/tran/instrbow.h b/tran/instrbow.h new file mode 100644 index 0000000..2da6d16 --- /dev/null +++ b/tran/instrbow.h @@ -0,0 +1,5 @@ +sound_type snd_make_bowed(double freq, sound_type bowpress_env, rate_type sr); +sound_type snd_bowed(double freq, sound_type bowpress_env, rate_type sr); + /* LISP: (snd-bowed ANYNUM SOUND ANYNUM) */ + + #define BOW_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrbowedfreq.alg b/tran/instrbowedfreq.alg new file mode 100644 index 0000000..dca0b46 --- /dev/null +++ b/tran/instrbowedfreq.alg @@ -0,0 +1,28 @@ +(INSTRBOWED-FREQ-ALG +(NAME "bowed_freq") +(ARGUMENTS ("double" "freq") ("sound_type" "bowpress_env") + ("sound_type" "freq_env") ("rate_type" "sr")) +(STATE ("struct instr *" "mybow" "initInstrument(BOWED, round(sr)); + controlChange(susp->mybow, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->mybow, freq, 1.0)") + ("double" "frequency" "freq")) +(START (min bowpress_env)) +(NOT-IN-INNER-LOOP "temp_ret_value") +(CONSTANT "frequency") +(SAMPLE-RATE "sr") +(MATCHED-SAMPLE-RATE freq_env bowpress_env) +(TERMINATE (min bowpress_env)) +(INNER-LOOP " + controlChange(mybow, 128, BOW_CONTROL_CHANGE_CONST * bowpress_env); + setFrequency(mybow, frequency + freq_env); + output = (sample_type) tick(mybow)") +(SUPPORT-HEADER " + #define BOW_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->mybow); +") +) diff --git a/tran/instrbowedfreq.c b/tran/instrbowedfreq.c new file mode 100644 index 0000000..99961bb --- /dev/null +++ b/tran/instrbowedfreq.c @@ -0,0 +1,298 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrbowedfreq.h" + +void bowed_freq_free(); + + +typedef struct bowed_freq_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type bowpress_env; + long bowpress_env_cnt; + sample_block_values_type bowpress_env_ptr; + sound_type freq_env; + long freq_env_cnt; + sample_block_values_type freq_env_ptr; + + struct instr *mybow; + int temp_ret_value; + double frequency; +} bowed_freq_susp_node, *bowed_freq_susp_type; + + + #include "instr.h" + + +void bowed_freq_nn_fetch(register bowed_freq_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 struct instr * mybow_reg; + register double frequency_reg; + register sample_block_values_type freq_env_ptr_reg; + register sample_block_values_type bowpress_env_ptr_reg; + falloc_sample_block(out, "bowed_freq_nn_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 bowpress_env input sample block: */ + susp_check_term_samples(bowpress_env, bowpress_env_ptr, bowpress_env_cnt); + togo = min(togo, susp->bowpress_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + mybow_reg = susp->mybow; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + bowpress_env_ptr_reg = susp->bowpress_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(mybow_reg, 128, BOW_CONTROL_CHANGE_CONST * *bowpress_env_ptr_reg++); + setFrequency(mybow_reg, frequency_reg + *freq_env_ptr_reg++); + *out_ptr_reg++ = (sample_type) tick(mybow_reg); + } while (--n); /* inner loop */ + + susp->mybow = mybow_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using bowpress_env_ptr_reg is a bad idea on RS/6000: */ + susp->bowpress_env_ptr += togo; + out_ptr += togo; + susp_took(bowpress_env_cnt, togo); + susp_took(freq_env_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; + } +} /* bowed_freq_nn_fetch */ + + +void bowed_freq_ss_fetch(register bowed_freq_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 struct instr * mybow_reg; + register double frequency_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_type bowpress_env_scale_reg = susp->bowpress_env->scale; + register sample_block_values_type bowpress_env_ptr_reg; + falloc_sample_block(out, "bowed_freq_ss_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 bowpress_env input sample block: */ + susp_check_term_samples(bowpress_env, bowpress_env_ptr, bowpress_env_cnt); + togo = min(togo, susp->bowpress_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + mybow_reg = susp->mybow; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + bowpress_env_ptr_reg = susp->bowpress_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(mybow_reg, 128, BOW_CONTROL_CHANGE_CONST * (bowpress_env_scale_reg * *bowpress_env_ptr_reg++)); + setFrequency(mybow_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(mybow_reg); + } while (--n); /* inner loop */ + + susp->mybow = mybow_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using bowpress_env_ptr_reg is a bad idea on RS/6000: */ + susp->bowpress_env_ptr += togo; + out_ptr += togo; + susp_took(bowpress_env_cnt, togo); + susp_took(freq_env_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; + } +} /* bowed_freq_ss_fetch */ + + +void bowed_freq_toss_fetch(susp, snd_list) + register bowed_freq_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from bowpress_env up to final_time for this block of zeros */ + while ((round((final_time - susp->bowpress_env->t0) * susp->bowpress_env->sr)) >= + susp->bowpress_env->current) + susp_get_samples(bowpress_env, bowpress_env_ptr, bowpress_env_cnt); + /* fetch samples from freq_env up to final_time for this block of zeros */ + while ((round((final_time - susp->freq_env->t0) * susp->freq_env->sr)) >= + susp->freq_env->current) + susp_get_samples(freq_env, freq_env_ptr, freq_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->bowpress_env->t0) * susp->bowpress_env->sr - + (susp->bowpress_env->current - susp->bowpress_env_cnt)); + susp->bowpress_env_ptr += n; + susp_took(bowpress_env_cnt, n); + n = round((final_time - susp->freq_env->t0) * susp->freq_env->sr - + (susp->freq_env->current - susp->freq_env_cnt)); + susp->freq_env_ptr += n; + susp_took(freq_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void bowed_freq_mark(bowed_freq_susp_type susp) +{ + sound_xlmark(susp->bowpress_env); + sound_xlmark(susp->freq_env); +} + + +void bowed_freq_free(bowed_freq_susp_type susp) +{ + + deleteInstrument(susp->mybow); + sound_unref(susp->bowpress_env); + sound_unref(susp->freq_env); + ffree_generic(susp, sizeof(bowed_freq_susp_node), "bowed_freq_free"); +} + + +void bowed_freq_print_tree(bowed_freq_susp_type susp, int n) +{ + indent(n); + stdputstr("bowpress_env:"); + sound_print_tree_1(susp->bowpress_env, n); + + indent(n); + stdputstr("freq_env:"); + sound_print_tree_1(susp->freq_env, n); +} + + +sound_type snd_make_bowed_freq(double freq, sound_type bowpress_env, sound_type freq_env, rate_type sr) +{ + register bowed_freq_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = bowpress_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, bowed_freq_susp_node, "snd_make_bowed_freq"); + susp->mybow = initInstrument(BOWED, round(sr)); + controlChange(susp->mybow, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->mybow, freq, 1.0); + susp->frequency = freq; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(bowpress_env, sr); + interp_desc = (interp_desc << 2) + interp_style(freq_env, sr); + switch (interp_desc) { + case INTERP_nn: susp->susp.fetch = bowed_freq_nn_fetch; break; + case INTERP_ss: susp->susp.fetch = bowed_freq_ss_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < bowpress_env->t0) sound_prepend_zeros(bowpress_env, t0); + if (t0 < freq_env->t0) sound_prepend_zeros(freq_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(bowpress_env->t0, min(freq_env->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 = bowed_freq_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = bowed_freq_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = bowed_freq_mark; + susp->susp.print_tree = bowed_freq_print_tree; + susp->susp.name = "bowed_freq"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->bowpress_env = bowpress_env; + susp->bowpress_env_cnt = 0; + susp->freq_env = freq_env; + susp->freq_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_bowed_freq(double freq, sound_type bowpress_env, sound_type freq_env, rate_type sr) +{ + sound_type bowpress_env_copy = sound_copy(bowpress_env); + sound_type freq_env_copy = sound_copy(freq_env); + return snd_make_bowed_freq(freq, bowpress_env_copy, freq_env_copy, sr); +} diff --git a/tran/instrbowedfreq.h b/tran/instrbowedfreq.h new file mode 100644 index 0000000..8b657c9 --- /dev/null +++ b/tran/instrbowedfreq.h @@ -0,0 +1,5 @@ +sound_type snd_make_bowed_freq(double freq, sound_type bowpress_env, sound_type freq_env, rate_type sr); +sound_type snd_bowed_freq(double freq, sound_type bowpress_env, sound_type freq_env, rate_type sr); + /* LISP: (snd-bowed_freq ANYNUM SOUND SOUND ANYNUM) */ + + #define BOW_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrclar.alg b/tran/instrclar.alg new file mode 100644 index 0000000..7146792 --- /dev/null +++ b/tran/instrclar.alg @@ -0,0 +1,25 @@ +(INSTRCLAR-ALG +(NAME "clarinet") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("rate_type" "sr")) +(STATE ("struct instr *" "clar" "initInstrument(CLARINET, round(sr)); + controlChange(susp->clar, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->clar, freq, 1.0)")) +(START (min breath_env)) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value") +(SAMPLE-RATE "sr") +(ALWAYS-SCALE breath_env) +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(clar, 128, CLAR_CONTROL_CHANGE_CONST * breath_env); + output = (sample_type) tick(clar)") +(SUPPORT-HEADER " + #define CLAR_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->clar); +") +) + diff --git a/tran/instrclar.c b/tran/instrclar.c new file mode 100644 index 0000000..8f9cb38 --- /dev/null +++ b/tran/instrclar.c @@ -0,0 +1,181 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrclar.h" + +void clarinet_free(); + + +typedef struct clarinet_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + + struct instr *clar; + int temp_ret_value; +} clarinet_susp_node, *clarinet_susp_type; + + + #include "instr.h" + + +void clarinet_s_fetch(register clarinet_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 struct instr * clar_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "clarinet_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_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; + clar_reg = susp->clar; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(clar_reg, 128, CLAR_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(clar_reg); + } while (--n); /* inner loop */ + + susp->clar = clar_reg; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_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; + } +} /* clarinet_s_fetch */ + + +void clarinet_toss_fetch(susp, snd_list) + register clarinet_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void clarinet_mark(clarinet_susp_type susp) +{ + sound_xlmark(susp->breath_env); +} + + +void clarinet_free(clarinet_susp_type susp) +{ + + deleteInstrument(susp->clar); + sound_unref(susp->breath_env); + ffree_generic(susp, sizeof(clarinet_susp_node), "clarinet_free"); +} + + +void clarinet_print_tree(clarinet_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); +} + + +sound_type snd_make_clarinet(double freq, sound_type breath_env, rate_type sr) +{ + register clarinet_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, clarinet_susp_node, "snd_make_clarinet"); + susp->clar = initInstrument(CLARINET, round(sr)); + controlChange(susp->clar, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->clar, freq, 1.0); + susp->susp.fetch = clarinet_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->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 = clarinet_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = clarinet_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = clarinet_mark; + susp->susp.print_tree = clarinet_print_tree; + susp->susp.name = "clarinet"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_clarinet(double freq, sound_type breath_env, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + return snd_make_clarinet(freq, breath_env_copy, sr); +} diff --git a/tran/instrclar.h b/tran/instrclar.h new file mode 100644 index 0000000..7408945 --- /dev/null +++ b/tran/instrclar.h @@ -0,0 +1,5 @@ +sound_type snd_make_clarinet(double freq, sound_type breath_env, rate_type sr); +sound_type snd_clarinet(double freq, sound_type breath_env, rate_type sr); + /* LISP: (snd-clarinet ANYNUM SOUND ANYNUM) */ + + #define CLAR_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrclarall.alg b/tran/instrclarall.alg new file mode 100644 index 0000000..a10f26c --- /dev/null +++ b/tran/instrclarall.alg @@ -0,0 +1,44 @@ +(INSTRCLAR-COMPLETE-ALG + +;; parameters are: +;; freq_env -- frequency modulation, aftertouch 128 +;; breath_env -- amplitude envelope, aftertouch 128 +;; vibrato_freq -- vibrato frequency, ModFreq 11 +;; vibrato_gain -- vibrato gain, ModWheel 1 +;; reed_stiffness -- reed stiffness, ReedStiff 2 +;; noise -- noise, Noise 4 +;; +(NAME "clarinet_all") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("sound_type" "freq_env") + ("double" "vibrato_freq") ("double" "vibrato_gain") + ("sound_type" "reed_stiffness") ("sound_type" "noise") ("rate_type" "sr")) +;; use a constant rate of 1.0 because it will actually be conrolled +;; by breath_env +(STATE ("struct instr *" "clar" "initInstrument(CLARINET, round(sr)); + noteOn(susp->clar, freq, 1.0); + controlChange(susp->clar, 11, CLAR_CONTROL_CHANGE_CONST * vibrato_freq); + controlChange(susp->clar, 1, CLAR_CONTROL_CHANGE_CONST * vibrato_gain);") + ("double" "frequency" "freq")) +(START (min breath_env)) +(MATCHED-SAMPLE-RATE freq_env breath_env reed_stiffness noise) +(ALWAYS-SCALE freq_env breath_env reed_stiffness noise) +(CONSTANT "frequency") +(SAMPLE-RATE "sr") +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(clar, 128, CLAR_CONTROL_CHANGE_CONST * breath_env); + controlChange(clar, 2, CLAR_CONTROL_CHANGE_CONST * reed_stiffness); + controlChange(clar, 4, CLAR_CONTROL_CHANGE_CONST * noise); + setFrequency(clar, frequency + freq_env); + output = (sample_type) tick(clar)") +(SUPPORT-HEADER " + #define CLAR_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->clar); +") +) + diff --git a/tran/instrclarall.c b/tran/instrclarall.c new file mode 100644 index 0000000..7b65cc1 --- /dev/null +++ b/tran/instrclarall.c @@ -0,0 +1,281 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrclarall.h" + +void clarinet_all_free(); + + +typedef struct clarinet_all_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + sound_type freq_env; + long freq_env_cnt; + sample_block_values_type freq_env_ptr; + sound_type reed_stiffness; + long reed_stiffness_cnt; + sample_block_values_type reed_stiffness_ptr; + sound_type noise; + long noise_cnt; + sample_block_values_type noise_ptr; + + struct instr *clar; + double frequency; +} clarinet_all_susp_node, *clarinet_all_susp_type; + + + #include "instr.h" + + +void clarinet_all_ssss_fetch(register clarinet_all_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 struct instr * clar_reg; + register double frequency_reg; + register sample_type noise_scale_reg = susp->noise->scale; + register sample_block_values_type noise_ptr_reg; + register sample_type reed_stiffness_scale_reg = susp->reed_stiffness->scale; + register sample_block_values_type reed_stiffness_ptr_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "clarinet_all_ssss_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_cnt); + + /* don't run past the reed_stiffness input sample block: */ + susp_check_samples(reed_stiffness, reed_stiffness_ptr, reed_stiffness_cnt); + togo = min(togo, susp->reed_stiffness_cnt); + + /* don't run past the noise input sample block: */ + susp_check_samples(noise, noise_ptr, noise_cnt); + togo = min(togo, susp->noise_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; + clar_reg = susp->clar; + frequency_reg = susp->frequency; + noise_ptr_reg = susp->noise_ptr; + reed_stiffness_ptr_reg = susp->reed_stiffness_ptr; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(clar_reg, 128, CLAR_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + controlChange(clar_reg, 2, CLAR_CONTROL_CHANGE_CONST * (reed_stiffness_scale_reg * *reed_stiffness_ptr_reg++)); + controlChange(clar_reg, 4, CLAR_CONTROL_CHANGE_CONST * (noise_scale_reg * *noise_ptr_reg++)); + setFrequency(clar_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(clar_reg); + } while (--n); /* inner loop */ + + susp->clar = clar_reg; + /* using noise_ptr_reg is a bad idea on RS/6000: */ + susp->noise_ptr += togo; + /* using reed_stiffness_ptr_reg is a bad idea on RS/6000: */ + susp->reed_stiffness_ptr += togo; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_cnt, togo); + susp_took(reed_stiffness_cnt, togo); + susp_took(noise_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; + } +} /* clarinet_all_ssss_fetch */ + + +void clarinet_all_toss_fetch(susp, snd_list) + register clarinet_all_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* fetch samples from freq_env up to final_time for this block of zeros */ + while ((round((final_time - susp->freq_env->t0) * susp->freq_env->sr)) >= + susp->freq_env->current) + susp_get_samples(freq_env, freq_env_ptr, freq_env_cnt); + /* fetch samples from reed_stiffness up to final_time for this block of zeros */ + while ((round((final_time - susp->reed_stiffness->t0) * susp->reed_stiffness->sr)) >= + susp->reed_stiffness->current) + susp_get_samples(reed_stiffness, reed_stiffness_ptr, reed_stiffness_cnt); + /* fetch samples from noise up to final_time for this block of zeros */ + while ((round((final_time - susp->noise->t0) * susp->noise->sr)) >= + susp->noise->current) + susp_get_samples(noise, noise_ptr, noise_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + n = round((final_time - susp->freq_env->t0) * susp->freq_env->sr - + (susp->freq_env->current - susp->freq_env_cnt)); + susp->freq_env_ptr += n; + susp_took(freq_env_cnt, n); + n = round((final_time - susp->reed_stiffness->t0) * susp->reed_stiffness->sr - + (susp->reed_stiffness->current - susp->reed_stiffness_cnt)); + susp->reed_stiffness_ptr += n; + susp_took(reed_stiffness_cnt, n); + n = round((final_time - susp->noise->t0) * susp->noise->sr - + (susp->noise->current - susp->noise_cnt)); + susp->noise_ptr += n; + susp_took(noise_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void clarinet_all_mark(clarinet_all_susp_type susp) +{ + sound_xlmark(susp->breath_env); + sound_xlmark(susp->freq_env); + sound_xlmark(susp->reed_stiffness); + sound_xlmark(susp->noise); +} + + +void clarinet_all_free(clarinet_all_susp_type susp) +{ + + deleteInstrument(susp->clar); + sound_unref(susp->breath_env); + sound_unref(susp->freq_env); + sound_unref(susp->reed_stiffness); + sound_unref(susp->noise); + ffree_generic(susp, sizeof(clarinet_all_susp_node), "clarinet_all_free"); +} + + +void clarinet_all_print_tree(clarinet_all_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); + + indent(n); + stdputstr("freq_env:"); + sound_print_tree_1(susp->freq_env, n); + + indent(n); + stdputstr("reed_stiffness:"); + sound_print_tree_1(susp->reed_stiffness, n); + + indent(n); + stdputstr("noise:"); + sound_print_tree_1(susp->noise, n); +} + + +sound_type snd_make_clarinet_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, rate_type sr) +{ + register clarinet_all_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, clarinet_all_susp_node, "snd_make_clarinet_all"); + susp->clar = initInstrument(CLARINET, round(sr)); + noteOn(susp->clar, freq, 1.0); + controlChange(susp->clar, 11, CLAR_CONTROL_CHANGE_CONST * vibrato_freq); + controlChange(susp->clar, 1, CLAR_CONTROL_CHANGE_CONST * vibrato_gain);; + susp->frequency = freq; + susp->susp.fetch = clarinet_all_ssss_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + if (t0 < freq_env->t0) sound_prepend_zeros(freq_env, t0); + if (t0 < reed_stiffness->t0) sound_prepend_zeros(reed_stiffness, t0); + if (t0 < noise->t0) sound_prepend_zeros(noise, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->t0, min(freq_env->t0, min(reed_stiffness->t0, min(noise->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 = clarinet_all_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = clarinet_all_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = clarinet_all_mark; + susp->susp.print_tree = clarinet_all_print_tree; + susp->susp.name = "clarinet_all"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + susp->freq_env = freq_env; + susp->freq_env_cnt = 0; + susp->reed_stiffness = reed_stiffness; + susp->reed_stiffness_cnt = 0; + susp->noise = noise; + susp->noise_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_clarinet_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + sound_type freq_env_copy = sound_copy(freq_env); + sound_type reed_stiffness_copy = sound_copy(reed_stiffness); + sound_type noise_copy = sound_copy(noise); + return snd_make_clarinet_all(freq, breath_env_copy, freq_env_copy, vibrato_freq, vibrato_gain, reed_stiffness_copy, noise_copy, sr); +} diff --git a/tran/instrclarall.h b/tran/instrclarall.h new file mode 100644 index 0000000..5f47d10 --- /dev/null +++ b/tran/instrclarall.h @@ -0,0 +1,5 @@ +sound_type snd_make_clarinet_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, rate_type sr); +sound_type snd_clarinet_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, rate_type sr); + /* LISP: (snd-clarinet_all ANYNUM SOUND SOUND ANYNUM ANYNUM SOUND SOUND ANYNUM) */ + + #define CLAR_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrclarfreq.alg b/tran/instrclarfreq.alg new file mode 100644 index 0000000..3e408b6 --- /dev/null +++ b/tran/instrclarfreq.alg @@ -0,0 +1,29 @@ +(INSTRCLAR-FREQ-ALG +(NAME "clarinet_freq") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("sound_type" "freq_env") + ("rate_type" "sr")) +(STATE ("struct instr *" "clar" "initInstrument(CLARINET, round(sr)); + controlChange(susp->clar, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->clar, freq, 1.0)") + ("double" "frequency" "freq")) +(START (min breath_env)) +(NOT-IN-INNER-LOOP "temp_ret_value") +(CONSTANT "frequency") +(SAMPLE-RATE "sr") +(MATCHED-SAMPLE-RATE freq_env breath_env) +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(clar, 128, CLAR_CONTROL_CHANGE_CONST * breath_env); + setFrequency(clar, frequency + freq_env); + output = (sample_type) tick(clar)") +(SUPPORT-HEADER " + #define CLAR_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->clar); +") +) + diff --git a/tran/instrclarfreq.c b/tran/instrclarfreq.c new file mode 100644 index 0000000..7f1e8c6 --- /dev/null +++ b/tran/instrclarfreq.c @@ -0,0 +1,298 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrclarfreq.h" + +void clarinet_freq_free(); + + +typedef struct clarinet_freq_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + sound_type freq_env; + long freq_env_cnt; + sample_block_values_type freq_env_ptr; + + struct instr *clar; + int temp_ret_value; + double frequency; +} clarinet_freq_susp_node, *clarinet_freq_susp_type; + + + #include "instr.h" + + +void clarinet_freq_nn_fetch(register clarinet_freq_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 struct instr * clar_reg; + register double frequency_reg; + register sample_block_values_type freq_env_ptr_reg; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "clarinet_freq_nn_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + clar_reg = susp->clar; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(clar_reg, 128, CLAR_CONTROL_CHANGE_CONST * *breath_env_ptr_reg++); + setFrequency(clar_reg, frequency_reg + *freq_env_ptr_reg++); + *out_ptr_reg++ = (sample_type) tick(clar_reg); + } while (--n); /* inner loop */ + + susp->clar = clar_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* clarinet_freq_nn_fetch */ + + +void clarinet_freq_ss_fetch(register clarinet_freq_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 struct instr * clar_reg; + register double frequency_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "clarinet_freq_ss_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + clar_reg = susp->clar; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(clar_reg, 128, CLAR_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + setFrequency(clar_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(clar_reg); + } while (--n); /* inner loop */ + + susp->clar = clar_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* clarinet_freq_ss_fetch */ + + +void clarinet_freq_toss_fetch(susp, snd_list) + register clarinet_freq_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* fetch samples from freq_env up to final_time for this block of zeros */ + while ((round((final_time - susp->freq_env->t0) * susp->freq_env->sr)) >= + susp->freq_env->current) + susp_get_samples(freq_env, freq_env_ptr, freq_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + n = round((final_time - susp->freq_env->t0) * susp->freq_env->sr - + (susp->freq_env->current - susp->freq_env_cnt)); + susp->freq_env_ptr += n; + susp_took(freq_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void clarinet_freq_mark(clarinet_freq_susp_type susp) +{ + sound_xlmark(susp->breath_env); + sound_xlmark(susp->freq_env); +} + + +void clarinet_freq_free(clarinet_freq_susp_type susp) +{ + + deleteInstrument(susp->clar); + sound_unref(susp->breath_env); + sound_unref(susp->freq_env); + ffree_generic(susp, sizeof(clarinet_freq_susp_node), "clarinet_freq_free"); +} + + +void clarinet_freq_print_tree(clarinet_freq_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); + + indent(n); + stdputstr("freq_env:"); + sound_print_tree_1(susp->freq_env, n); +} + + +sound_type snd_make_clarinet_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr) +{ + register clarinet_freq_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, clarinet_freq_susp_node, "snd_make_clarinet_freq"); + susp->clar = initInstrument(CLARINET, round(sr)); + controlChange(susp->clar, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->clar, freq, 1.0); + susp->frequency = freq; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(breath_env, sr); + interp_desc = (interp_desc << 2) + interp_style(freq_env, sr); + switch (interp_desc) { + case INTERP_nn: susp->susp.fetch = clarinet_freq_nn_fetch; break; + case INTERP_ss: susp->susp.fetch = clarinet_freq_ss_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + if (t0 < freq_env->t0) sound_prepend_zeros(freq_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->t0, min(freq_env->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 = clarinet_freq_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = clarinet_freq_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = clarinet_freq_mark; + susp->susp.print_tree = clarinet_freq_print_tree; + susp->susp.name = "clarinet_freq"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + susp->freq_env = freq_env; + susp->freq_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_clarinet_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + sound_type freq_env_copy = sound_copy(freq_env); + return snd_make_clarinet_freq(freq, breath_env_copy, freq_env_copy, sr); +} diff --git a/tran/instrclarfreq.h b/tran/instrclarfreq.h new file mode 100644 index 0000000..1ee6a22 --- /dev/null +++ b/tran/instrclarfreq.h @@ -0,0 +1,5 @@ +sound_type snd_make_clarinet_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr); +sound_type snd_clarinet_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr); + /* LISP: (snd-clarinet_freq ANYNUM SOUND SOUND ANYNUM) */ + + #define CLAR_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrflute.alg b/tran/instrflute.alg new file mode 100644 index 0000000..363d9a5 --- /dev/null +++ b/tran/instrflute.alg @@ -0,0 +1,25 @@ +(INSTRFLUTE-ALG +(NAME "flute") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("rate_type" "sr")) +(STATE ("struct instr *" "myflute" "initInstrument(FLUTE, round(sr)); + controlChange(susp->myflute, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->myflute, freq, 1.0)")) +(START (min breath_env)) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value") +(SAMPLE-RATE "sr") +(ALWAYS-SCALE breath_env) +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(myflute, 128, FLUTE_CONTROL_CHANGE_CONST * breath_env); + output = (sample_type) tick(myflute)") +(SUPPORT-HEADER " + #define FLUTE_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->myflute); +") +) + diff --git a/tran/instrflute.c b/tran/instrflute.c new file mode 100644 index 0000000..eebefed --- /dev/null +++ b/tran/instrflute.c @@ -0,0 +1,181 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrflute.h" + +void flute_free(); + + +typedef struct flute_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + + struct instr *myflute; + int temp_ret_value; +} flute_susp_node, *flute_susp_type; + + + #include "instr.h" + + +void flute_s_fetch(register flute_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 struct instr * myflute_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "flute_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_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; + myflute_reg = susp->myflute; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(myflute_reg, 128, FLUTE_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(myflute_reg); + } while (--n); /* inner loop */ + + susp->myflute = myflute_reg; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_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; + } +} /* flute_s_fetch */ + + +void flute_toss_fetch(susp, snd_list) + register flute_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void flute_mark(flute_susp_type susp) +{ + sound_xlmark(susp->breath_env); +} + + +void flute_free(flute_susp_type susp) +{ + + deleteInstrument(susp->myflute); + sound_unref(susp->breath_env); + ffree_generic(susp, sizeof(flute_susp_node), "flute_free"); +} + + +void flute_print_tree(flute_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); +} + + +sound_type snd_make_flute(double freq, sound_type breath_env, rate_type sr) +{ + register flute_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, flute_susp_node, "snd_make_flute"); + susp->myflute = initInstrument(FLUTE, round(sr)); + controlChange(susp->myflute, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->myflute, freq, 1.0); + susp->susp.fetch = flute_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->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 = flute_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = flute_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = flute_mark; + susp->susp.print_tree = flute_print_tree; + susp->susp.name = "flute"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_flute(double freq, sound_type breath_env, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + return snd_make_flute(freq, breath_env_copy, sr); +} diff --git a/tran/instrflute.h b/tran/instrflute.h new file mode 100644 index 0000000..3158cbd --- /dev/null +++ b/tran/instrflute.h @@ -0,0 +1,5 @@ +sound_type snd_make_flute(double freq, sound_type breath_env, rate_type sr); +sound_type snd_flute(double freq, sound_type breath_env, rate_type sr); + /* LISP: (snd-flute ANYNUM SOUND ANYNUM) */ + + #define FLUTE_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrfluteall.alg b/tran/instrfluteall.alg new file mode 100644 index 0000000..045b52b --- /dev/null +++ b/tran/instrfluteall.alg @@ -0,0 +1,43 @@ +(INSTRFLUTEALL-ALG + +;; parameters are: +;; freq_env -- frequency modulation, aftertouch 128 +;; breath_env -- amplitude envelope, aftertouch 128 +;; vibrato_freq -- vibrato frequency, ModFreq 11 +;; vibrato_gain -- vibrato gain, ModWheel 1 +;; jet_delay -- jet delay, 2 +;; noise -- noise, Noise 4 +;; +(NAME "flute_all") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("sound_type" "freq_env") + ("double" "vibrato_freq") ("double" "vibrato_gain") + ("sound_type" "jet_delay") ("sound_type" "noise") ("rate_type" "sr")) +;; use a constant rate of 1.0 because it will actually be conrolled +;; by breath_env +(STATE ("struct instr *" "myflute" "initInstrument(FLUTE, round(sr)); + noteOn(susp->myflute, freq, 1.0); + controlChange(susp->myflute, 11, FLUTE_CONTROL_CHANGE_CONST * vibrato_freq); + controlChange(susp->myflute, 1, FLUTE_CONTROL_CHANGE_CONST * vibrato_gain);") + ("double" "frequency" "freq")) +(START (min breath_env)) +(MATCHED-SAMPLE-RATE freq_env breath_env jet_delay noise) +(ALWAYS-SCALE freq_env breath_env jet_delay noise) +(CONSTANT "frequency") +(SAMPLE-RATE "sr") +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(myflute, 128, FLUTE_CONTROL_CHANGE_CONST * breath_env); + controlChange(myflute, 2, FLUTE_CONTROL_CHANGE_CONST * jet_delay); + controlChange(myflute, 4, FLUTE_CONTROL_CHANGE_CONST * noise); + setFrequency(myflute, frequency + freq_env); + output = (sample_type) tick(myflute)") +(SUPPORT-HEADER " + #define FLUTE_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->myflute); +") +) diff --git a/tran/instrfluteall.c b/tran/instrfluteall.c new file mode 100644 index 0000000..64e3f56 --- /dev/null +++ b/tran/instrfluteall.c @@ -0,0 +1,281 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrfluteall.h" + +void flute_all_free(); + + +typedef struct flute_all_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + sound_type freq_env; + long freq_env_cnt; + sample_block_values_type freq_env_ptr; + sound_type jet_delay; + long jet_delay_cnt; + sample_block_values_type jet_delay_ptr; + sound_type noise; + long noise_cnt; + sample_block_values_type noise_ptr; + + struct instr *myflute; + double frequency; +} flute_all_susp_node, *flute_all_susp_type; + + + #include "instr.h" + + +void flute_all_ssss_fetch(register flute_all_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 struct instr * myflute_reg; + register double frequency_reg; + register sample_type noise_scale_reg = susp->noise->scale; + register sample_block_values_type noise_ptr_reg; + register sample_type jet_delay_scale_reg = susp->jet_delay->scale; + register sample_block_values_type jet_delay_ptr_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "flute_all_ssss_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_cnt); + + /* don't run past the jet_delay input sample block: */ + susp_check_samples(jet_delay, jet_delay_ptr, jet_delay_cnt); + togo = min(togo, susp->jet_delay_cnt); + + /* don't run past the noise input sample block: */ + susp_check_samples(noise, noise_ptr, noise_cnt); + togo = min(togo, susp->noise_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; + myflute_reg = susp->myflute; + frequency_reg = susp->frequency; + noise_ptr_reg = susp->noise_ptr; + jet_delay_ptr_reg = susp->jet_delay_ptr; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(myflute_reg, 128, FLUTE_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + controlChange(myflute_reg, 2, FLUTE_CONTROL_CHANGE_CONST * (jet_delay_scale_reg * *jet_delay_ptr_reg++)); + controlChange(myflute_reg, 4, FLUTE_CONTROL_CHANGE_CONST * (noise_scale_reg * *noise_ptr_reg++)); + setFrequency(myflute_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(myflute_reg); + } while (--n); /* inner loop */ + + susp->myflute = myflute_reg; + /* using noise_ptr_reg is a bad idea on RS/6000: */ + susp->noise_ptr += togo; + /* using jet_delay_ptr_reg is a bad idea on RS/6000: */ + susp->jet_delay_ptr += togo; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_cnt, togo); + susp_took(jet_delay_cnt, togo); + susp_took(noise_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; + } +} /* flute_all_ssss_fetch */ + + +void flute_all_toss_fetch(susp, snd_list) + register flute_all_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* fetch samples from freq_env up to final_time for this block of zeros */ + while ((round((final_time - susp->freq_env->t0) * susp->freq_env->sr)) >= + susp->freq_env->current) + susp_get_samples(freq_env, freq_env_ptr, freq_env_cnt); + /* fetch samples from jet_delay up to final_time for this block of zeros */ + while ((round((final_time - susp->jet_delay->t0) * susp->jet_delay->sr)) >= + susp->jet_delay->current) + susp_get_samples(jet_delay, jet_delay_ptr, jet_delay_cnt); + /* fetch samples from noise up to final_time for this block of zeros */ + while ((round((final_time - susp->noise->t0) * susp->noise->sr)) >= + susp->noise->current) + susp_get_samples(noise, noise_ptr, noise_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + n = round((final_time - susp->freq_env->t0) * susp->freq_env->sr - + (susp->freq_env->current - susp->freq_env_cnt)); + susp->freq_env_ptr += n; + susp_took(freq_env_cnt, n); + n = round((final_time - susp->jet_delay->t0) * susp->jet_delay->sr - + (susp->jet_delay->current - susp->jet_delay_cnt)); + susp->jet_delay_ptr += n; + susp_took(jet_delay_cnt, n); + n = round((final_time - susp->noise->t0) * susp->noise->sr - + (susp->noise->current - susp->noise_cnt)); + susp->noise_ptr += n; + susp_took(noise_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void flute_all_mark(flute_all_susp_type susp) +{ + sound_xlmark(susp->breath_env); + sound_xlmark(susp->freq_env); + sound_xlmark(susp->jet_delay); + sound_xlmark(susp->noise); +} + + +void flute_all_free(flute_all_susp_type susp) +{ + + deleteInstrument(susp->myflute); + sound_unref(susp->breath_env); + sound_unref(susp->freq_env); + sound_unref(susp->jet_delay); + sound_unref(susp->noise); + ffree_generic(susp, sizeof(flute_all_susp_node), "flute_all_free"); +} + + +void flute_all_print_tree(flute_all_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); + + indent(n); + stdputstr("freq_env:"); + sound_print_tree_1(susp->freq_env, n); + + indent(n); + stdputstr("jet_delay:"); + sound_print_tree_1(susp->jet_delay, n); + + indent(n); + stdputstr("noise:"); + sound_print_tree_1(susp->noise, n); +} + + +sound_type snd_make_flute_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type jet_delay, sound_type noise, rate_type sr) +{ + register flute_all_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, flute_all_susp_node, "snd_make_flute_all"); + susp->myflute = initInstrument(FLUTE, round(sr)); + noteOn(susp->myflute, freq, 1.0); + controlChange(susp->myflute, 11, FLUTE_CONTROL_CHANGE_CONST * vibrato_freq); + controlChange(susp->myflute, 1, FLUTE_CONTROL_CHANGE_CONST * vibrato_gain);; + susp->frequency = freq; + susp->susp.fetch = flute_all_ssss_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + if (t0 < freq_env->t0) sound_prepend_zeros(freq_env, t0); + if (t0 < jet_delay->t0) sound_prepend_zeros(jet_delay, t0); + if (t0 < noise->t0) sound_prepend_zeros(noise, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->t0, min(freq_env->t0, min(jet_delay->t0, min(noise->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 = flute_all_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = flute_all_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = flute_all_mark; + susp->susp.print_tree = flute_all_print_tree; + susp->susp.name = "flute_all"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + susp->freq_env = freq_env; + susp->freq_env_cnt = 0; + susp->jet_delay = jet_delay; + susp->jet_delay_cnt = 0; + susp->noise = noise; + susp->noise_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_flute_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type jet_delay, sound_type noise, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + sound_type freq_env_copy = sound_copy(freq_env); + sound_type jet_delay_copy = sound_copy(jet_delay); + sound_type noise_copy = sound_copy(noise); + return snd_make_flute_all(freq, breath_env_copy, freq_env_copy, vibrato_freq, vibrato_gain, jet_delay_copy, noise_copy, sr); +} diff --git a/tran/instrfluteall.h b/tran/instrfluteall.h new file mode 100644 index 0000000..f8ca679 --- /dev/null +++ b/tran/instrfluteall.h @@ -0,0 +1,5 @@ +sound_type snd_make_flute_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type jet_delay, sound_type noise, rate_type sr); +sound_type snd_flute_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type jet_delay, sound_type noise, rate_type sr); + /* LISP: (snd-flute_all ANYNUM SOUND SOUND ANYNUM ANYNUM SOUND SOUND ANYNUM) */ + + #define FLUTE_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrflutefreq.alg b/tran/instrflutefreq.alg new file mode 100644 index 0000000..bab34ec --- /dev/null +++ b/tran/instrflutefreq.alg @@ -0,0 +1,28 @@ +(INSTRFLUTE-FREQ--ALG +(NAME "flute_freq") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") + ("sound_type" "freq_env") ("rate_type" "sr")) +(STATE ("struct instr *" "myflute" "initInstrument(FLUTE, round(sr)); + controlChange(susp->myflute, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->myflute, freq, 1.0)") + ("double" "frequency" "freq")) +(START (min breath_env)) +(NOT-IN-INNER-LOOP "temp_ret_value") +(CONSTANT "frequency") +(SAMPLE-RATE "sr") +(MATCHED-SAMPLE-RATE freq_env breath_env) +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(myflute, 128, FLUTE_CONTROL_CHANGE_CONST * breath_env); + setFrequency(myflute, frequency + freq_env); + output = (sample_type) tick(myflute)") +(SUPPORT-HEADER " + #define FLUTE_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->myflute); +") +) diff --git a/tran/instrflutefreq.c b/tran/instrflutefreq.c new file mode 100644 index 0000000..8369edf --- /dev/null +++ b/tran/instrflutefreq.c @@ -0,0 +1,298 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrflutefreq.h" + +void flute_freq_free(); + + +typedef struct flute_freq_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + sound_type freq_env; + long freq_env_cnt; + sample_block_values_type freq_env_ptr; + + struct instr *myflute; + int temp_ret_value; + double frequency; +} flute_freq_susp_node, *flute_freq_susp_type; + + + #include "instr.h" + + +void flute_freq_nn_fetch(register flute_freq_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 struct instr * myflute_reg; + register double frequency_reg; + register sample_block_values_type freq_env_ptr_reg; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "flute_freq_nn_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + myflute_reg = susp->myflute; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(myflute_reg, 128, FLUTE_CONTROL_CHANGE_CONST * *breath_env_ptr_reg++); + setFrequency(myflute_reg, frequency_reg + *freq_env_ptr_reg++); + *out_ptr_reg++ = (sample_type) tick(myflute_reg); + } while (--n); /* inner loop */ + + susp->myflute = myflute_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* flute_freq_nn_fetch */ + + +void flute_freq_ss_fetch(register flute_freq_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 struct instr * myflute_reg; + register double frequency_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "flute_freq_ss_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + myflute_reg = susp->myflute; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(myflute_reg, 128, FLUTE_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + setFrequency(myflute_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(myflute_reg); + } while (--n); /* inner loop */ + + susp->myflute = myflute_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* flute_freq_ss_fetch */ + + +void flute_freq_toss_fetch(susp, snd_list) + register flute_freq_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* fetch samples from freq_env up to final_time for this block of zeros */ + while ((round((final_time - susp->freq_env->t0) * susp->freq_env->sr)) >= + susp->freq_env->current) + susp_get_samples(freq_env, freq_env_ptr, freq_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + n = round((final_time - susp->freq_env->t0) * susp->freq_env->sr - + (susp->freq_env->current - susp->freq_env_cnt)); + susp->freq_env_ptr += n; + susp_took(freq_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void flute_freq_mark(flute_freq_susp_type susp) +{ + sound_xlmark(susp->breath_env); + sound_xlmark(susp->freq_env); +} + + +void flute_freq_free(flute_freq_susp_type susp) +{ + + deleteInstrument(susp->myflute); + sound_unref(susp->breath_env); + sound_unref(susp->freq_env); + ffree_generic(susp, sizeof(flute_freq_susp_node), "flute_freq_free"); +} + + +void flute_freq_print_tree(flute_freq_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); + + indent(n); + stdputstr("freq_env:"); + sound_print_tree_1(susp->freq_env, n); +} + + +sound_type snd_make_flute_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr) +{ + register flute_freq_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, flute_freq_susp_node, "snd_make_flute_freq"); + susp->myflute = initInstrument(FLUTE, round(sr)); + controlChange(susp->myflute, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->myflute, freq, 1.0); + susp->frequency = freq; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(breath_env, sr); + interp_desc = (interp_desc << 2) + interp_style(freq_env, sr); + switch (interp_desc) { + case INTERP_nn: susp->susp.fetch = flute_freq_nn_fetch; break; + case INTERP_ss: susp->susp.fetch = flute_freq_ss_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + if (t0 < freq_env->t0) sound_prepend_zeros(freq_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->t0, min(freq_env->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 = flute_freq_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = flute_freq_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = flute_freq_mark; + susp->susp.print_tree = flute_freq_print_tree; + susp->susp.name = "flute_freq"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + susp->freq_env = freq_env; + susp->freq_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_flute_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + sound_type freq_env_copy = sound_copy(freq_env); + return snd_make_flute_freq(freq, breath_env_copy, freq_env_copy, sr); +} diff --git a/tran/instrflutefreq.h b/tran/instrflutefreq.h new file mode 100644 index 0000000..15ca31d --- /dev/null +++ b/tran/instrflutefreq.h @@ -0,0 +1,5 @@ +sound_type snd_make_flute_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr); +sound_type snd_flute_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr); + /* LISP: (snd-flute_freq ANYNUM SOUND SOUND ANYNUM) */ + + #define FLUTE_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrmandolin.alg b/tran/instrmandolin.alg new file mode 100644 index 0000000..4d1654e --- /dev/null +++ b/tran/instrmandolin.alg @@ -0,0 +1,25 @@ +(INSTRMANDOLIN-ALG +(NAME "mandolin") +(ARGUMENTS ("time_type" "t0")("double" "freq") ("time_type" "d") + ("double" "body_size")("double" "detune")("rate_type" "sr")) +(STATE ("struct instr *" "mymand" "initInstrument(MANDOLIN, round(sr)); + controlChange(susp->mymand, 1, detune); + controlChange(susp->mymand, 2, MAND_CONTROL_CHANGE_CONST * body_size);") + ("int" "temp_ret_value" "noteOn(susp->mymand, freq, 1.0)")) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value" "body_size" "detune") +(SAMPLE-RATE "sr") +(TERMINATE (after "d")) +(INNER-LOOP " + output = (sample_type) tick(mymand)") +(SUPPORT-HEADER " + #define MAND_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" + +") +(FINALIZATION " + deleteInstrument(susp->mymand); +") +) + diff --git a/tran/instrmandolin.c b/tran/instrmandolin.c new file mode 100644 index 0000000..6beae2a --- /dev/null +++ b/tran/instrmandolin.c @@ -0,0 +1,121 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrmandolin.h" + +void mandolin_free(); + + +typedef struct mandolin_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + struct instr *mymand; + int temp_ret_value; +} mandolin_susp_node, *mandolin_susp_type; + + + #include "instr.h" + + + +void mandolin__fetch(register mandolin_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 struct instr * mymand_reg; + falloc_sample_block(out, "mandolin__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; + } + + n = togo; + mymand_reg = susp->mymand; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) tick(mymand_reg); + } while (--n); /* inner loop */ + + susp->mymand = mymand_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; + } +} /* mandolin__fetch */ + + +void mandolin_free(mandolin_susp_type susp) +{ + + deleteInstrument(susp->mymand); + ffree_generic(susp, sizeof(mandolin_susp_node), "mandolin_free"); +} + + +void mandolin_print_tree(mandolin_susp_type susp, int n) +{ +} + + +sound_type snd_make_mandolin(time_type t0, double freq, time_type d, double body_size, double detune, rate_type sr) +{ + register mandolin_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, mandolin_susp_node, "snd_make_mandolin"); + susp->mymand = initInstrument(MANDOLIN, round(sr)); + controlChange(susp->mymand, 1, detune); + controlChange(susp->mymand, 2, MAND_CONTROL_CHANGE_CONST * body_size);; + susp->temp_ret_value = noteOn(susp->mymand, freq, 1.0); + susp->susp.fetch = mandolin__fetch; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = mandolin_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = mandolin_print_tree; + susp->susp.name = "mandolin"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_mandolin(time_type t0, double freq, time_type d, double body_size, double detune, rate_type sr) +{ + return snd_make_mandolin(t0, freq, d, body_size, detune, sr); +} diff --git a/tran/instrmandolin.h b/tran/instrmandolin.h new file mode 100644 index 0000000..965cbe3 --- /dev/null +++ b/tran/instrmandolin.h @@ -0,0 +1,5 @@ +sound_type snd_make_mandolin(time_type t0, double freq, time_type d, double body_size, double detune, rate_type sr); +sound_type snd_mandolin(time_type t0, double freq, time_type d, double body_size, double detune, rate_type sr); + /* LISP: (snd-mandolin ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ + + #define MAND_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrmodalbar.alg b/tran/instrmodalbar.alg new file mode 100644 index 0000000..4a2cc34 --- /dev/null +++ b/tran/instrmodalbar.alg @@ -0,0 +1,19 @@ +(INSTRMODALBAR-ALG +(NAME "modalbar") +(ARGUMENTS ("time_type" "t0")("double" "freq") ("int" "preset")("time_type" "dur") ("rate_type" "sr")) +(STATE ("struct instr *" "mymbar" "initInstrument(MODALBAR, round(sr)); + controlChange(susp->mymbar, 16, preset);") + ("int" "temp_ret_value" "noteOn(susp->mymbar, freq, 1.0);")) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value") +(SAMPLE-RATE "sr") +(TERMINATE (after "dur")) +(INNER-LOOP " + output = (sample_type) tick(mymbar)") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->mymbar); +") +) + diff --git a/tran/instrmodalbar.c b/tran/instrmodalbar.c new file mode 100644 index 0000000..29b0035 --- /dev/null +++ b/tran/instrmodalbar.c @@ -0,0 +1,119 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrmodalbar.h" + +void modalbar_free(); + + +typedef struct modalbar_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + struct instr *mymbar; + int temp_ret_value; +} modalbar_susp_node, *modalbar_susp_type; + + + #include "instr.h" + + +void modalbar__fetch(register modalbar_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 struct instr * mymbar_reg; + falloc_sample_block(out, "modalbar__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; + } + + n = togo; + mymbar_reg = susp->mymbar; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) tick(mymbar_reg); + } while (--n); /* inner loop */ + + susp->mymbar = mymbar_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; + } +} /* modalbar__fetch */ + + +void modalbar_free(modalbar_susp_type susp) +{ + + deleteInstrument(susp->mymbar); + ffree_generic(susp, sizeof(modalbar_susp_node), "modalbar_free"); +} + + +void modalbar_print_tree(modalbar_susp_type susp, int n) +{ +} + + +sound_type snd_make_modalbar(time_type t0, double freq, int preset, time_type dur, rate_type sr) +{ + register modalbar_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, modalbar_susp_node, "snd_make_modalbar"); + susp->mymbar = initInstrument(MODALBAR, round(sr)); + controlChange(susp->mymbar, 16, preset);; + susp->temp_ret_value = noteOn(susp->mymbar, freq, 1.0);; + susp->susp.fetch = modalbar__fetch; + + susp->terminate_cnt = round((dur) * sr); + /* initialize susp state */ + susp->susp.free = modalbar_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = modalbar_print_tree; + susp->susp.name = "modalbar"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_modalbar(time_type t0, double freq, int preset, time_type dur, rate_type sr) +{ + return snd_make_modalbar(t0, freq, preset, dur, sr); +} diff --git a/tran/instrmodalbar.h b/tran/instrmodalbar.h new file mode 100644 index 0000000..21c9ac4 --- /dev/null +++ b/tran/instrmodalbar.h @@ -0,0 +1,3 @@ +sound_type snd_make_modalbar(time_type t0, double freq, int preset, time_type dur, rate_type sr); +sound_type snd_modalbar(time_type t0, double freq, int preset, time_type dur, rate_type sr); + /* LISP: (snd-modalbar ANYNUM ANYNUM FIXNUM ANYNUM ANYNUM) */ diff --git a/tran/instrsax.alg b/tran/instrsax.alg new file mode 100644 index 0000000..d708839 --- /dev/null +++ b/tran/instrsax.alg @@ -0,0 +1,24 @@ +(INSTRSAX-ALG +(NAME "sax") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("rate_type" "sr")) +(STATE ("struct instr *" "sax" "initInstrument(SAXOFONY, round(sr)); + controlChange(susp->sax, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->sax, freq, 1.0)")) +(START (min breath_env)) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value") +(SAMPLE-RATE "sr") +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(sax, 128, SAX_CONTROL_CHANGE_CONST * breath_env); + output = (sample_type) tick(sax)") +(SUPPORT-HEADER " + #define SAX_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->sax); +") +) + diff --git a/tran/instrsax.c b/tran/instrsax.c new file mode 100644 index 0000000..e70b3a6 --- /dev/null +++ b/tran/instrsax.c @@ -0,0 +1,249 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrsax.h" + +void sax_free(); + + +typedef struct sax_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + + struct instr *sax; + int temp_ret_value; +} sax_susp_node, *sax_susp_type; + + + #include "instr.h" + + +void sax_n_fetch(register sax_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 struct instr * sax_reg; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "sax_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_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; + sax_reg = susp->sax; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(sax_reg, 128, SAX_CONTROL_CHANGE_CONST * *breath_env_ptr_reg++); + *out_ptr_reg++ = (sample_type) tick(sax_reg); + } while (--n); /* inner loop */ + + susp->sax = sax_reg; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_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; + } +} /* sax_n_fetch */ + + +void sax_s_fetch(register sax_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 struct instr * sax_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "sax_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_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; + sax_reg = susp->sax; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(sax_reg, 128, SAX_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(sax_reg); + } while (--n); /* inner loop */ + + susp->sax = sax_reg; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_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; + } +} /* sax_s_fetch */ + + +void sax_toss_fetch(susp, snd_list) + register sax_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void sax_mark(sax_susp_type susp) +{ + sound_xlmark(susp->breath_env); +} + + +void sax_free(sax_susp_type susp) +{ + + deleteInstrument(susp->sax); + sound_unref(susp->breath_env); + ffree_generic(susp, sizeof(sax_susp_node), "sax_free"); +} + + +void sax_print_tree(sax_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); +} + + +sound_type snd_make_sax(double freq, sound_type breath_env, rate_type sr) +{ + register sax_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, sax_susp_node, "snd_make_sax"); + susp->sax = initInstrument(SAXOFONY, round(sr)); + controlChange(susp->sax, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->sax, freq, 1.0); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(breath_env, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = sax_n_fetch; break; + case INTERP_s: susp->susp.fetch = sax_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->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 = sax_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = sax_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = sax_mark; + susp->susp.print_tree = sax_print_tree; + susp->susp.name = "sax"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_sax(double freq, sound_type breath_env, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + return snd_make_sax(freq, breath_env_copy, sr); +} diff --git a/tran/instrsax.h b/tran/instrsax.h new file mode 100644 index 0000000..4227342 --- /dev/null +++ b/tran/instrsax.h @@ -0,0 +1,5 @@ +sound_type snd_make_sax(double freq, sound_type breath_env, rate_type sr); +sound_type snd_sax(double freq, sound_type breath_env, rate_type sr); + /* LISP: (snd-sax ANYNUM SOUND ANYNUM) */ + + #define SAX_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrsaxall.alg b/tran/instrsaxall.alg new file mode 100644 index 0000000..bcc61ad --- /dev/null +++ b/tran/instrsaxall.alg @@ -0,0 +1,38 @@ +(INSTRSAX-COMPLETE-ALG +(NAME "sax_all") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("sound_type" "freq_env") + ("double" "vibrato_freq") ("double" "vibrato_gain") + ("sound_type" "reed_stiffness") ("sound_type" "noise") + ("sound_type" "blow_pos") ("sound_type" "reed_table_offset") + ("rate_type" "sr")) +(STATE ("struct instr *" "sax" "initInstrument(SAXOFONY, round(sr)); + noteOn(susp->sax, freq, 1.0); + controlChange(susp->sax, 29, SAX_CONTROL_CHANGE_CONST * vibrato_freq); + controlChange(susp->sax, 1, SAX_CONTROL_CHANGE_CONST * vibrato_gain);") + ("double" "frequency" "freq")) +(START (min breath_env)) +(MATCHED-SAMPLE-RATE freq_env breath_env + reed_stiffness noise blow_pos reed_table_offset) +(CONSTANT "frequency") +(ALWAYS-SCALE freq_env breath_env reed_stiffness noise blow_pos reed_table_offset) +(SAMPLE-RATE "sr") +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(sax, 128, SAX_CONTROL_CHANGE_CONST * breath_env); + controlChange(sax, 2, SAX_CONTROL_CHANGE_CONST * reed_stiffness); + controlChange(sax, 4, SAX_CONTROL_CHANGE_CONST * noise); + controlChange(sax, 11, SAX_CONTROL_CHANGE_CONST * blow_pos); + controlChange(sax, 26, SAX_CONTROL_CHANGE_CONST * reed_table_offset); + setFrequency(sax, frequency + freq_env); + output = (sample_type) tick(sax)") +(SUPPORT-HEADER " + #define SAX_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->sax); +") +) + diff --git a/tran/instrsaxall.c b/tran/instrsaxall.c new file mode 100644 index 0000000..6b0aa89 --- /dev/null +++ b/tran/instrsaxall.c @@ -0,0 +1,345 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrsaxall.h" + +void sax_all_free(); + + +typedef struct sax_all_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + sound_type freq_env; + long freq_env_cnt; + sample_block_values_type freq_env_ptr; + sound_type reed_stiffness; + long reed_stiffness_cnt; + sample_block_values_type reed_stiffness_ptr; + sound_type noise; + long noise_cnt; + sample_block_values_type noise_ptr; + sound_type blow_pos; + long blow_pos_cnt; + sample_block_values_type blow_pos_ptr; + sound_type reed_table_offset; + long reed_table_offset_cnt; + sample_block_values_type reed_table_offset_ptr; + + struct instr *sax; + double frequency; +} sax_all_susp_node, *sax_all_susp_type; + + + #include "instr.h" + + +void sax_all_ssssss_fetch(register sax_all_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 struct instr * sax_reg; + register double frequency_reg; + register sample_type reed_table_offset_scale_reg = susp->reed_table_offset->scale; + register sample_block_values_type reed_table_offset_ptr_reg; + register sample_type blow_pos_scale_reg = susp->blow_pos->scale; + register sample_block_values_type blow_pos_ptr_reg; + register sample_type noise_scale_reg = susp->noise->scale; + register sample_block_values_type noise_ptr_reg; + register sample_type reed_stiffness_scale_reg = susp->reed_stiffness->scale; + register sample_block_values_type reed_stiffness_ptr_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "sax_all_ssssss_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_cnt); + + /* don't run past the reed_stiffness input sample block: */ + susp_check_samples(reed_stiffness, reed_stiffness_ptr, reed_stiffness_cnt); + togo = min(togo, susp->reed_stiffness_cnt); + + /* don't run past the noise input sample block: */ + susp_check_samples(noise, noise_ptr, noise_cnt); + togo = min(togo, susp->noise_cnt); + + /* don't run past the blow_pos input sample block: */ + susp_check_samples(blow_pos, blow_pos_ptr, blow_pos_cnt); + togo = min(togo, susp->blow_pos_cnt); + + /* don't run past the reed_table_offset input sample block: */ + susp_check_samples(reed_table_offset, reed_table_offset_ptr, reed_table_offset_cnt); + togo = min(togo, susp->reed_table_offset_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; + sax_reg = susp->sax; + frequency_reg = susp->frequency; + reed_table_offset_ptr_reg = susp->reed_table_offset_ptr; + blow_pos_ptr_reg = susp->blow_pos_ptr; + noise_ptr_reg = susp->noise_ptr; + reed_stiffness_ptr_reg = susp->reed_stiffness_ptr; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(sax_reg, 128, SAX_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + controlChange(sax_reg, 2, SAX_CONTROL_CHANGE_CONST * (reed_stiffness_scale_reg * *reed_stiffness_ptr_reg++)); + controlChange(sax_reg, 4, SAX_CONTROL_CHANGE_CONST * (noise_scale_reg * *noise_ptr_reg++)); + controlChange(sax_reg, 11, SAX_CONTROL_CHANGE_CONST * (blow_pos_scale_reg * *blow_pos_ptr_reg++)); + controlChange(sax_reg, 26, SAX_CONTROL_CHANGE_CONST * (reed_table_offset_scale_reg * *reed_table_offset_ptr_reg++)); + setFrequency(sax_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(sax_reg); + } while (--n); /* inner loop */ + + susp->sax = sax_reg; + /* using reed_table_offset_ptr_reg is a bad idea on RS/6000: */ + susp->reed_table_offset_ptr += togo; + /* using blow_pos_ptr_reg is a bad idea on RS/6000: */ + susp->blow_pos_ptr += togo; + /* using noise_ptr_reg is a bad idea on RS/6000: */ + susp->noise_ptr += togo; + /* using reed_stiffness_ptr_reg is a bad idea on RS/6000: */ + susp->reed_stiffness_ptr += togo; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_cnt, togo); + susp_took(reed_stiffness_cnt, togo); + susp_took(noise_cnt, togo); + susp_took(blow_pos_cnt, togo); + susp_took(reed_table_offset_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; + } +} /* sax_all_ssssss_fetch */ + + +void sax_all_toss_fetch(susp, snd_list) + register sax_all_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* fetch samples from freq_env up to final_time for this block of zeros */ + while ((round((final_time - susp->freq_env->t0) * susp->freq_env->sr)) >= + susp->freq_env->current) + susp_get_samples(freq_env, freq_env_ptr, freq_env_cnt); + /* fetch samples from reed_stiffness up to final_time for this block of zeros */ + while ((round((final_time - susp->reed_stiffness->t0) * susp->reed_stiffness->sr)) >= + susp->reed_stiffness->current) + susp_get_samples(reed_stiffness, reed_stiffness_ptr, reed_stiffness_cnt); + /* fetch samples from noise up to final_time for this block of zeros */ + while ((round((final_time - susp->noise->t0) * susp->noise->sr)) >= + susp->noise->current) + susp_get_samples(noise, noise_ptr, noise_cnt); + /* fetch samples from blow_pos up to final_time for this block of zeros */ + while ((round((final_time - susp->blow_pos->t0) * susp->blow_pos->sr)) >= + susp->blow_pos->current) + susp_get_samples(blow_pos, blow_pos_ptr, blow_pos_cnt); + /* fetch samples from reed_table_offset up to final_time for this block of zeros */ + while ((round((final_time - susp->reed_table_offset->t0) * susp->reed_table_offset->sr)) >= + susp->reed_table_offset->current) + susp_get_samples(reed_table_offset, reed_table_offset_ptr, reed_table_offset_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + n = round((final_time - susp->freq_env->t0) * susp->freq_env->sr - + (susp->freq_env->current - susp->freq_env_cnt)); + susp->freq_env_ptr += n; + susp_took(freq_env_cnt, n); + n = round((final_time - susp->reed_stiffness->t0) * susp->reed_stiffness->sr - + (susp->reed_stiffness->current - susp->reed_stiffness_cnt)); + susp->reed_stiffness_ptr += n; + susp_took(reed_stiffness_cnt, n); + n = round((final_time - susp->noise->t0) * susp->noise->sr - + (susp->noise->current - susp->noise_cnt)); + susp->noise_ptr += n; + susp_took(noise_cnt, n); + n = round((final_time - susp->blow_pos->t0) * susp->blow_pos->sr - + (susp->blow_pos->current - susp->blow_pos_cnt)); + susp->blow_pos_ptr += n; + susp_took(blow_pos_cnt, n); + n = round((final_time - susp->reed_table_offset->t0) * susp->reed_table_offset->sr - + (susp->reed_table_offset->current - susp->reed_table_offset_cnt)); + susp->reed_table_offset_ptr += n; + susp_took(reed_table_offset_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void sax_all_mark(sax_all_susp_type susp) +{ + sound_xlmark(susp->breath_env); + sound_xlmark(susp->freq_env); + sound_xlmark(susp->reed_stiffness); + sound_xlmark(susp->noise); + sound_xlmark(susp->blow_pos); + sound_xlmark(susp->reed_table_offset); +} + + +void sax_all_free(sax_all_susp_type susp) +{ + + deleteInstrument(susp->sax); + sound_unref(susp->breath_env); + sound_unref(susp->freq_env); + sound_unref(susp->reed_stiffness); + sound_unref(susp->noise); + sound_unref(susp->blow_pos); + sound_unref(susp->reed_table_offset); + ffree_generic(susp, sizeof(sax_all_susp_node), "sax_all_free"); +} + + +void sax_all_print_tree(sax_all_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); + + indent(n); + stdputstr("freq_env:"); + sound_print_tree_1(susp->freq_env, n); + + indent(n); + stdputstr("reed_stiffness:"); + sound_print_tree_1(susp->reed_stiffness, n); + + indent(n); + stdputstr("noise:"); + sound_print_tree_1(susp->noise, n); + + indent(n); + stdputstr("blow_pos:"); + sound_print_tree_1(susp->blow_pos, n); + + indent(n); + stdputstr("reed_table_offset:"); + sound_print_tree_1(susp->reed_table_offset, n); +} + + +sound_type snd_make_sax_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, sound_type blow_pos, sound_type reed_table_offset, rate_type sr) +{ + register sax_all_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, sax_all_susp_node, "snd_make_sax_all"); + susp->sax = initInstrument(SAXOFONY, round(sr)); + noteOn(susp->sax, freq, 1.0); + controlChange(susp->sax, 29, SAX_CONTROL_CHANGE_CONST * vibrato_freq); + controlChange(susp->sax, 1, SAX_CONTROL_CHANGE_CONST * vibrato_gain);; + susp->frequency = freq; + susp->susp.fetch = sax_all_ssssss_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + if (t0 < freq_env->t0) sound_prepend_zeros(freq_env, t0); + if (t0 < reed_stiffness->t0) sound_prepend_zeros(reed_stiffness, t0); + if (t0 < noise->t0) sound_prepend_zeros(noise, t0); + if (t0 < blow_pos->t0) sound_prepend_zeros(blow_pos, t0); + if (t0 < reed_table_offset->t0) sound_prepend_zeros(reed_table_offset, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->t0, min(freq_env->t0, min(reed_stiffness->t0, min(noise->t0, min(blow_pos->t0, min(reed_table_offset->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 = sax_all_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = sax_all_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = sax_all_mark; + susp->susp.print_tree = sax_all_print_tree; + susp->susp.name = "sax_all"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + susp->freq_env = freq_env; + susp->freq_env_cnt = 0; + susp->reed_stiffness = reed_stiffness; + susp->reed_stiffness_cnt = 0; + susp->noise = noise; + susp->noise_cnt = 0; + susp->blow_pos = blow_pos; + susp->blow_pos_cnt = 0; + susp->reed_table_offset = reed_table_offset; + susp->reed_table_offset_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_sax_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, sound_type blow_pos, sound_type reed_table_offset, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + sound_type freq_env_copy = sound_copy(freq_env); + sound_type reed_stiffness_copy = sound_copy(reed_stiffness); + sound_type noise_copy = sound_copy(noise); + sound_type blow_pos_copy = sound_copy(blow_pos); + sound_type reed_table_offset_copy = sound_copy(reed_table_offset); + return snd_make_sax_all(freq, breath_env_copy, freq_env_copy, vibrato_freq, vibrato_gain, reed_stiffness_copy, noise_copy, blow_pos_copy, reed_table_offset_copy, sr); +} diff --git a/tran/instrsaxall.h b/tran/instrsaxall.h new file mode 100644 index 0000000..d8d0c51 --- /dev/null +++ b/tran/instrsaxall.h @@ -0,0 +1,5 @@ +sound_type snd_make_sax_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, sound_type blow_pos, sound_type reed_table_offset, rate_type sr); +sound_type snd_sax_all(double freq, sound_type breath_env, sound_type freq_env, double vibrato_freq, double vibrato_gain, sound_type reed_stiffness, sound_type noise, sound_type blow_pos, sound_type reed_table_offset, rate_type sr); + /* LISP: (snd-sax_all ANYNUM SOUND SOUND ANYNUM ANYNUM SOUND SOUND SOUND SOUND ANYNUM) */ + + #define SAX_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrsaxfreq.alg b/tran/instrsaxfreq.alg new file mode 100644 index 0000000..09ef2d6 --- /dev/null +++ b/tran/instrsaxfreq.alg @@ -0,0 +1,27 @@ +(INSTRSAX-FREQ-ALG +(NAME "sax_freq") +(ARGUMENTS ("double" "freq") ("sound_type" "breath_env") ("sound_type" "freq_env") ("rate_type" "sr")) +(STATE ("struct instr *" "sax" "initInstrument(SAXOFONY, round(sr)); + controlChange(susp->sax, 1, 0.0);") + ("int" "temp_ret_value" "noteOn(susp->sax, freq, 1.0)") + ("double" "frequency" "freq")) +(START (min breath_env)) +(NOT-IN-INNER-LOOP "temp_ret_value") +(CONSTANT "frequency") +(SAMPLE-RATE "sr") +(TERMINATE (min breath_env)) +(INNER-LOOP " + controlChange(sax, 128, SAX_CONTROL_CHANGE_CONST * breath_env); + setFrequency(sax, frequency + freq_env); + output = (sample_type) tick(sax)") +(SUPPORT-HEADER " + #define SAX_CONTROL_CHANGE_CONST 128 +") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->sax); +") +) + diff --git a/tran/instrsaxfreq.c b/tran/instrsaxfreq.c new file mode 100644 index 0000000..284dd7f --- /dev/null +++ b/tran/instrsaxfreq.c @@ -0,0 +1,446 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrsaxfreq.h" + +void sax_freq_free(); + + +typedef struct sax_freq_susp_struct { + snd_susp_node susp; + long terminate_cnt; + sound_type breath_env; + long breath_env_cnt; + sample_block_values_type breath_env_ptr; + sound_type freq_env; + long freq_env_cnt; + sample_block_values_type freq_env_ptr; + + struct instr *sax; + int temp_ret_value; + double frequency; +} sax_freq_susp_node, *sax_freq_susp_type; + + + #include "instr.h" + + +void sax_freq_nn_fetch(register sax_freq_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 struct instr * sax_reg; + register double frequency_reg; + register sample_block_values_type freq_env_ptr_reg; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "sax_freq_nn_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + sax_reg = susp->sax; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(sax_reg, 128, SAX_CONTROL_CHANGE_CONST * *breath_env_ptr_reg++); + setFrequency(sax_reg, frequency_reg + *freq_env_ptr_reg++); + *out_ptr_reg++ = (sample_type) tick(sax_reg); + } while (--n); /* inner loop */ + + susp->sax = sax_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* sax_freq_nn_fetch */ + + +void sax_freq_ns_fetch(register sax_freq_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 struct instr * sax_reg; + register double frequency_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "sax_freq_ns_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + sax_reg = susp->sax; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(sax_reg, 128, SAX_CONTROL_CHANGE_CONST * *breath_env_ptr_reg++); + setFrequency(sax_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(sax_reg); + } while (--n); /* inner loop */ + + susp->sax = sax_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* sax_freq_ns_fetch */ + + +void sax_freq_sn_fetch(register sax_freq_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 struct instr * sax_reg; + register double frequency_reg; + register sample_block_values_type freq_env_ptr_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "sax_freq_sn_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + sax_reg = susp->sax; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(sax_reg, 128, SAX_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + setFrequency(sax_reg, frequency_reg + *freq_env_ptr_reg++); + *out_ptr_reg++ = (sample_type) tick(sax_reg); + } while (--n); /* inner loop */ + + susp->sax = sax_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* sax_freq_sn_fetch */ + + +void sax_freq_ss_fetch(register sax_freq_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 struct instr * sax_reg; + register double frequency_reg; + register sample_type freq_env_scale_reg = susp->freq_env->scale; + register sample_block_values_type freq_env_ptr_reg; + register sample_type breath_env_scale_reg = susp->breath_env->scale; + register sample_block_values_type breath_env_ptr_reg; + falloc_sample_block(out, "sax_freq_ss_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 breath_env input sample block: */ + susp_check_term_samples(breath_env, breath_env_ptr, breath_env_cnt); + togo = min(togo, susp->breath_env_cnt); + + /* don't run past the freq_env input sample block: */ + susp_check_samples(freq_env, freq_env_ptr, freq_env_cnt); + togo = min(togo, susp->freq_env_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; + sax_reg = susp->sax; + frequency_reg = susp->frequency; + freq_env_ptr_reg = susp->freq_env_ptr; + breath_env_ptr_reg = susp->breath_env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + controlChange(sax_reg, 128, SAX_CONTROL_CHANGE_CONST * (breath_env_scale_reg * *breath_env_ptr_reg++)); + setFrequency(sax_reg, frequency_reg + (freq_env_scale_reg * *freq_env_ptr_reg++)); + *out_ptr_reg++ = (sample_type) tick(sax_reg); + } while (--n); /* inner loop */ + + susp->sax = sax_reg; + /* using freq_env_ptr_reg is a bad idea on RS/6000: */ + susp->freq_env_ptr += togo; + /* using breath_env_ptr_reg is a bad idea on RS/6000: */ + susp->breath_env_ptr += togo; + out_ptr += togo; + susp_took(breath_env_cnt, togo); + susp_took(freq_env_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; + } +} /* sax_freq_ss_fetch */ + + +void sax_freq_toss_fetch(susp, snd_list) + register sax_freq_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from breath_env up to final_time for this block of zeros */ + while ((round((final_time - susp->breath_env->t0) * susp->breath_env->sr)) >= + susp->breath_env->current) + susp_get_samples(breath_env, breath_env_ptr, breath_env_cnt); + /* fetch samples from freq_env up to final_time for this block of zeros */ + while ((round((final_time - susp->freq_env->t0) * susp->freq_env->sr)) >= + susp->freq_env->current) + susp_get_samples(freq_env, freq_env_ptr, freq_env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->breath_env->t0) * susp->breath_env->sr - + (susp->breath_env->current - susp->breath_env_cnt)); + susp->breath_env_ptr += n; + susp_took(breath_env_cnt, n); + n = round((final_time - susp->freq_env->t0) * susp->freq_env->sr - + (susp->freq_env->current - susp->freq_env_cnt)); + susp->freq_env_ptr += n; + susp_took(freq_env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void sax_freq_mark(sax_freq_susp_type susp) +{ + sound_xlmark(susp->breath_env); + sound_xlmark(susp->freq_env); +} + + +void sax_freq_free(sax_freq_susp_type susp) +{ + + deleteInstrument(susp->sax); + sound_unref(susp->breath_env); + sound_unref(susp->freq_env); + ffree_generic(susp, sizeof(sax_freq_susp_node), "sax_freq_free"); +} + + +void sax_freq_print_tree(sax_freq_susp_type susp, int n) +{ + indent(n); + stdputstr("breath_env:"); + sound_print_tree_1(susp->breath_env, n); + + indent(n); + stdputstr("freq_env:"); + sound_print_tree_1(susp->freq_env, n); +} + + +sound_type snd_make_sax_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr) +{ + register sax_freq_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = breath_env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, sax_freq_susp_node, "snd_make_sax_freq"); + susp->sax = initInstrument(SAXOFONY, round(sr)); + controlChange(susp->sax, 1, 0.0);; + susp->temp_ret_value = noteOn(susp->sax, freq, 1.0); + susp->frequency = freq; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(breath_env, sr); + interp_desc = (interp_desc << 2) + interp_style(freq_env, sr); + switch (interp_desc) { + case INTERP_nn: susp->susp.fetch = sax_freq_nn_fetch; break; + case INTERP_ns: susp->susp.fetch = sax_freq_ns_fetch; break; + case INTERP_sn: susp->susp.fetch = sax_freq_sn_fetch; break; + case INTERP_ss: susp->susp.fetch = sax_freq_ss_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < breath_env->t0) sound_prepend_zeros(breath_env, t0); + if (t0 < freq_env->t0) sound_prepend_zeros(freq_env, t0); + /* minimum start time over all inputs: */ + t0_min = min(breath_env->t0, min(freq_env->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 = sax_freq_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = sax_freq_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = sax_freq_mark; + susp->susp.print_tree = sax_freq_print_tree; + susp->susp.name = "sax_freq"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + susp->breath_env = breath_env; + susp->breath_env_cnt = 0; + susp->freq_env = freq_env; + susp->freq_env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_sax_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr) +{ + sound_type breath_env_copy = sound_copy(breath_env); + sound_type freq_env_copy = sound_copy(freq_env); + return snd_make_sax_freq(freq, breath_env_copy, freq_env_copy, sr); +} diff --git a/tran/instrsaxfreq.h b/tran/instrsaxfreq.h new file mode 100644 index 0000000..71e2f4d --- /dev/null +++ b/tran/instrsaxfreq.h @@ -0,0 +1,5 @@ +sound_type snd_make_sax_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr); +sound_type snd_sax_freq(double freq, sound_type breath_env, sound_type freq_env, rate_type sr); + /* LISP: (snd-sax_freq ANYNUM SOUND SOUND ANYNUM) */ + + #define SAX_CONTROL_CHANGE_CONST 128 diff --git a/tran/instrsitar.alg b/tran/instrsitar.alg new file mode 100644 index 0000000..d2d2d56 --- /dev/null +++ b/tran/instrsitar.alg @@ -0,0 +1,17 @@ +(INSTRSITAR-ALG +(NAME "sitar") +(ARGUMENTS ("time_type" "t0")("double" "freq")("time_type" "dur")("rate_type" "sr")) +(STATE ("struct instr *" "mysitar" "initInstrument(SITAR, round(sr))") + ("int" "temp_ret_value" "noteOn(susp->mysitar, freq, 1.0)")) +(NOT-IN-INNER-LOOP "freq" "temp_ret_value") +(SAMPLE-RATE "sr") +(TERMINATE (after "dur")) +(INNER-LOOP " + output = (sample_type) tick(mysitar)") +(SUPPORT-FUNCTIONS " + #include \"instr.h\" +") +(FINALIZATION " + deleteInstrument(susp->mysitar); +") +) diff --git a/tran/instrsitar.c b/tran/instrsitar.c new file mode 100644 index 0000000..9aa8127 --- /dev/null +++ b/tran/instrsitar.c @@ -0,0 +1,118 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "instrsitar.h" + +void sitar_free(); + + +typedef struct sitar_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + struct instr *mysitar; + int temp_ret_value; +} sitar_susp_node, *sitar_susp_type; + + + #include "instr.h" + + +void sitar__fetch(register sitar_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 struct instr * mysitar_reg; + falloc_sample_block(out, "sitar__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; + } + + n = togo; + mysitar_reg = susp->mysitar; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) tick(mysitar_reg); + } while (--n); /* inner loop */ + + susp->mysitar = mysitar_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; + } +} /* sitar__fetch */ + + +void sitar_free(sitar_susp_type susp) +{ + + deleteInstrument(susp->mysitar); + ffree_generic(susp, sizeof(sitar_susp_node), "sitar_free"); +} + + +void sitar_print_tree(sitar_susp_type susp, int n) +{ +} + + +sound_type snd_make_sitar(time_type t0, double freq, time_type dur, rate_type sr) +{ + register sitar_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, sitar_susp_node, "snd_make_sitar"); + susp->mysitar = initInstrument(SITAR, round(sr)); + susp->temp_ret_value = noteOn(susp->mysitar, freq, 1.0); + susp->susp.fetch = sitar__fetch; + + susp->terminate_cnt = round((dur) * sr); + /* initialize susp state */ + susp->susp.free = sitar_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = sitar_print_tree; + susp->susp.name = "sitar"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_sitar(time_type t0, double freq, time_type dur, rate_type sr) +{ + return snd_make_sitar(t0, freq, dur, sr); +} diff --git a/tran/instrsitar.h b/tran/instrsitar.h new file mode 100644 index 0000000..15d8d5d --- /dev/null +++ b/tran/instrsitar.h @@ -0,0 +1,3 @@ +sound_type snd_make_sitar(time_type t0, double freq, time_type dur, rate_type sr); +sound_type snd_sitar(time_type t0, double freq, time_type dur, rate_type sr); + /* LISP: (snd-sitar ANYNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/integrate.alg b/tran/integrate.alg new file mode 100644 index 0000000..34b4ecb --- /dev/null +++ b/tran/integrate.alg @@ -0,0 +1,12 @@ +(INTEGRATE-ALG +(NAME "integrate") +(ARGUMENTS ("sound_type" "input")) +(START (MIN input)) +(TERMINATE (MIN input)) +(LINEAR input) +(LOGICAL-STOP (MIN input)) +(STATE ("double" "integral" "0.0; + scale_factor = (sample_type) (scale_factor / input->sr)")) +(INNER-LOOP "output = (sample_type) integral; integral += input;") +) + diff --git a/tran/integrate.c b/tran/integrate.c new file mode 100644 index 0000000..f9459ff --- /dev/null +++ b/tran/integrate.c @@ -0,0 +1,211 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "integrate.h" + +void integrate_free(); + + +typedef struct integrate_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + double integral; +} integrate_susp_node, *integrate_susp_type; + + +void integrate_n_fetch(register integrate_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 double integral_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "integrate_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + integral_reg = susp->integral; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) integral_reg; integral_reg += *input_ptr_reg++;; + } while (--n); /* inner loop */ + + susp->integral = integral_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* integrate_n_fetch */ + + +void integrate_toss_fetch(susp, snd_list) + register integrate_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void integrate_mark(integrate_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void integrate_free(integrate_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(integrate_susp_node), "integrate_free"); +} + + +void integrate_print_tree(integrate_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_integrate(sound_type input) +{ + register integrate_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, integrate_susp_node, "snd_make_integrate"); + susp->integral = 0.0; + scale_factor = (sample_type) (scale_factor / input->sr); + susp->susp.fetch = integrate_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = integrate_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = integrate_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = integrate_mark; + susp->susp.print_tree = integrate_print_tree; + susp->susp.name = "integrate"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_integrate(sound_type input) +{ + sound_type input_copy = sound_copy(input); + return snd_make_integrate(input_copy); +} diff --git a/tran/integrate.h b/tran/integrate.h new file mode 100644 index 0000000..33ecbbc --- /dev/null +++ b/tran/integrate.h @@ -0,0 +1,3 @@ +sound_type snd_make_integrate(sound_type input); +sound_type snd_integrate(sound_type input); + /* LISP: (snd-integrate SOUND) */ diff --git a/tran/log.alg b/tran/log.alg new file mode 100644 index 0000000..b45c6bd --- /dev/null +++ b/tran/log.alg @@ -0,0 +1,9 @@ +(LOG-ALG + (NAME "log") + (ARGUMENTS ("sound_type" "input")) + (ALWAYS-SCALE input) + (START (MIN input)) + (INNER-LOOP "output = (sample_type) log(input)") + (TERMINATE (MIN input)) + (LOGICAL-STOP (MIN input)) +) diff --git a/tran/log.c b/tran/log.c new file mode 100644 index 0000000..deb8d99 --- /dev/null +++ b/tran/log.c @@ -0,0 +1,198 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "log.h" + +void log_free(); + + +typedef struct log_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; +} log_susp_node, *log_susp_type; + + +void log_s_fetch(register log_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 input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "log_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) log((input_scale_reg * *input_ptr_reg++)); + } while (--n); /* inner loop */ + + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* log_s_fetch */ + + +void log_toss_fetch(susp, snd_list) + register log_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void log_mark(log_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void log_free(log_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(log_susp_node), "log_free"); +} + + +void log_print_tree(log_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_log(sound_type input) +{ + register log_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, log_susp_node, "snd_make_log"); + susp->susp.fetch = log_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = log_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = log_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = log_mark; + susp->susp.print_tree = log_print_tree; + susp->susp.name = "log"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_log(sound_type input) +{ + sound_type input_copy = sound_copy(input); + return snd_make_log(input_copy); +} diff --git a/tran/log.h b/tran/log.h new file mode 100644 index 0000000..141a0ac --- /dev/null +++ b/tran/log.h @@ -0,0 +1,3 @@ +sound_type snd_make_log(sound_type input); +sound_type snd_log(sound_type input); + /* LISP: (snd-log SOUND) */ diff --git a/tran/lpreson.alg b/tran/lpreson.alg new file mode 100644 index 0000000..65e5179 --- /dev/null +++ b/tran/lpreson.alg @@ -0,0 +1,109 @@ +(LPRESON-ALG +(NAME "lpreson") +(ARGUMENTS ("sound_type" "x_snd")("LVAL" "src")("time_type" "frame_time")) +(SUPPORT-FUNCTIONS " +#include \"samples.h\" + +") +(START (MIN x_snd)) +(ALWAYS-SCALE x_snd) +(TERMINATE (MIN x_snd)) +(LOGICAL-STOP (MIN x_snd)) +(SAMPLE-RATE "x_snd->sr") +(STATE + ("long" "fr_indx" "0") + ("long" "ak_len" "0") ; length of coefs ak array + ("long" "frame_length" "(long) (frame_time*x_snd->sr)") ; samples length + ("LVAL" "src" "src") + ("LVAL" "frame" "NULL") + ("double *" "ak_coefs" "NULL") ; coefs array + ("double *" "zk_buf" "NULL") ; last values of output + ("double" "gain" "1.0") + ("long" "index" "0") + + ) + +(OUTER-LOOP " + if (susp->src == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + + if (susp->fr_indx >= susp->frame_length) + susp->fr_indx -= susp->frame_length; + + if (susp->fr_indx==0) + { + long i; + susp->frame = xleval(cons(s_send, cons(susp->src, consa(s_next)))); + if (susp->frame == NULL) { + susp->src = NULL; + goto out; +/* en susp->frame tenemos la lista proporcionada por el objeto */ + } else if (!listp(susp->frame) || !listp(cdr(susp->frame)) || + !listp(cdr(cdr(susp->frame))) || + !listp(cdr(cdr(cdr(susp->frame))))) { + xlerror(\"list expected\", susp->frame); + } + /* frame is a list: (RMS1 RMS2 ERR FILTER-COEFS) */ + /* gain is square root of RMS2 */ + susp->gain = sqrt(getflonum(car(cdr(susp->frame)))); + /* get filter coefs */ + susp->frame=car(cdr(cdr(cdr(susp->frame)))); + if (!vectorp(susp->frame)) { + xlerror(\"array expected\", susp->frame); + } + else if (susp->ak_coefs == NULL) { + susp->ak_len = getsize(susp->frame); + if (susp->ak_len < 1) xlerror(\"array has no elements\", susp->frame); + susp->ak_coefs = (double *) calloc(susp->ak_len, sizeof(double)); + susp->zk_buf = (double *) calloc(susp->ak_len, sizeof(double)); + } + /* at this point we have a new array and a place to put ak coefs */ + + for (i=0; i < susp->ak_len; i++) { + LVAL elem = getelement(susp->frame, i); + if (ntype(elem) != FLONUM) { + xlerror(\"flonum expected\", elem); + } + susp->ak_coefs[i] = getflonum(elem); + } + + // printf(\"NUEVO FILTRO: \"); /* here for debug */ + // for(k=0; k < susp->ak_len; k++) printf(\" %g \", susp->ak_coefs[k]); + // printf(\"GAIN %g AKLEN %d \", susp->gain, susp->ak_len); + + + + susp->frame = NULL; /* free the array */ + + +} + + togo = min(susp->frame_length - susp->fr_indx, togo); + +") + +(INNER-LOOP-LOCALS "double z0; long xi; long xj;") + +(INNER-LOOP " + z0 = x_snd * gain; + for (xi=0; xi < ak_len; xi++) { + xj = index + xi; if (xj >= ak_len) xj -= ak_len; + z0 += ak_coefs[xi] * zk_buf[xj]; + } + zk_buf[index] = z0; + index++; if (index == ak_len) index = 0; + fr_indx++; + output = (sample_type) z0; +") + +(CONSTANT "frame_length" "src") + +(FINALIZATION " free(susp->ak_coefs); + free(susp->zk_buf); +") + +) + + diff --git a/tran/lpreson.c b/tran/lpreson.c new file mode 100644 index 0000000..3c08f05 --- /dev/null +++ b/tran/lpreson.c @@ -0,0 +1,313 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "lpreson.h" + +void lpreson_free(); + + +typedef struct lpreson_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; + + long fr_indx; + long ak_len; + long frame_length; + LVAL src; + LVAL frame; + double *ak_coefs; + double *zk_buf; + double gain; + long index; +} lpreson_susp_node, *lpreson_susp_type; + + +#include "samples.h" + + + +void lpreson_s_fetch(register lpreson_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 long fr_indx_reg; + register long ak_len_reg; + register double * ak_coefs_reg; + register double * zk_buf_reg; + register double gain_reg; + register long index_reg; + register sample_type x_snd_scale_reg = susp->x_snd->scale; + register sample_block_values_type x_snd_ptr_reg; + falloc_sample_block(out, "lpreson_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: */ + susp_check_term_log_samples(x_snd, x_snd_ptr, x_snd_cnt); + 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; + } + } + + + if (susp->src == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + + if (susp->fr_indx >= susp->frame_length) + susp->fr_indx -= susp->frame_length; + + if (susp->fr_indx==0) + { + long i; + susp->frame = xleval(cons(s_send, cons(susp->src, consa(s_next)))); + if (susp->frame == NULL) { + susp->src = NULL; + goto out; +/* en susp->frame tenemos la lista proporcionada por el objeto */ + } else if (!listp(susp->frame) || !listp(cdr(susp->frame)) || + !listp(cdr(cdr(susp->frame))) || + !listp(cdr(cdr(cdr(susp->frame))))) { + xlerror("list expected", susp->frame); + } + /* frame is a list: (RMS1 RMS2 ERR FILTER-COEFS) */ + /* gain is square root of RMS2 */ + susp->gain = sqrt(getflonum(car(cdr(susp->frame)))); + /* get filter coefs */ + susp->frame=car(cdr(cdr(cdr(susp->frame)))); + if (!vectorp(susp->frame)) { + xlerror("array expected", susp->frame); + } + else if (susp->ak_coefs == NULL) { + susp->ak_len = getsize(susp->frame); + if (susp->ak_len < 1) xlerror("array has no elements", susp->frame); + susp->ak_coefs = (double *) calloc(susp->ak_len, sizeof(double)); + susp->zk_buf = (double *) calloc(susp->ak_len, sizeof(double)); + } + /* at this point we have a new array and a place to put ak coefs */ + + for (i=0; i < susp->ak_len; i++) { + LVAL elem = getelement(susp->frame, i); + if (ntype(elem) != FLONUM) { + xlerror("flonum expected", elem); + } + susp->ak_coefs[i] = getflonum(elem); + } + + // printf("NUEVO FILTRO: "); /* here for debug */ + // for(k=0; k < susp->ak_len; k++) printf(" %g ", susp->ak_coefs[k]); + // printf("GAIN %g AKLEN %d ", susp->gain, susp->ak_len); + + + + susp->frame = NULL; /* free the array */ + + +} + + togo = min(susp->frame_length - susp->fr_indx, togo); + + + n = togo; + fr_indx_reg = susp->fr_indx; + ak_len_reg = susp->ak_len; + ak_coefs_reg = susp->ak_coefs; + zk_buf_reg = susp->zk_buf; + gain_reg = susp->gain; + index_reg = susp->index; + x_snd_ptr_reg = susp->x_snd_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +double z0; long xi; long xj; + z0 = (x_snd_scale_reg * *x_snd_ptr_reg++) * gain_reg; + for (xi=0; xi < ak_len_reg; xi++) { + xj = index_reg + xi; if (xj >= ak_len_reg) xj -= ak_len_reg; + z0 += ak_coefs_reg[xi] * zk_buf_reg[xj]; + } + zk_buf_reg[index_reg] = z0; + index_reg++; if (index_reg == ak_len_reg) index_reg = 0; + fr_indx_reg++; + *out_ptr_reg++ = (sample_type) z0; +; + } while (--n); /* inner loop */ + + susp->fr_indx = fr_indx_reg; + susp->ak_len = ak_len_reg; + susp->ak_coefs = ak_coefs_reg; + susp->zk_buf = zk_buf_reg; + susp->gain = gain_reg; + susp->index = index_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; + } +} /* lpreson_s_fetch */ + + +void lpreson_toss_fetch(susp, snd_list) + register lpreson_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + 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 lpreson_mark(lpreson_susp_type susp) +{ + if (susp->frame) mark(susp->frame); + if (susp->src) mark(susp->src); + sound_xlmark(susp->x_snd); +} + + +void lpreson_free(lpreson_susp_type susp) +{ + free(susp->ak_coefs); + free(susp->zk_buf); + sound_unref(susp->x_snd); + ffree_generic(susp, sizeof(lpreson_susp_node), "lpreson_free"); +} + + +void lpreson_print_tree(lpreson_susp_type susp, int n) +{ + indent(n); + stdputstr("x_snd:"); + sound_print_tree_1(susp->x_snd, n); +} + + +sound_type snd_make_lpreson(sound_type x_snd, LVAL src, time_type frame_time) +{ + register lpreson_susp_type susp; + rate_type sr = x_snd->sr; + time_type t0 = x_snd->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, lpreson_susp_node, "snd_make_lpreson"); + susp->fr_indx = 0; + susp->ak_len = 0; + susp->frame_length = (long) (frame_time*x_snd->sr); + susp->src = src; + susp->frame = NULL; + susp->ak_coefs = NULL; + susp->zk_buf = NULL; + susp->gain = 1.0; + susp->index = 0; + susp->susp.fetch = lpreson_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 = lpreson_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = lpreson_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = lpreson_mark; + susp->susp.print_tree = lpreson_print_tree; + susp->susp.name = "lpreson"; + 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_lpreson(sound_type x_snd, LVAL src, time_type frame_time) +{ + sound_type x_snd_copy = sound_copy(x_snd); + return snd_make_lpreson(x_snd_copy, src, frame_time); +} diff --git a/tran/lpreson.h b/tran/lpreson.h new file mode 100644 index 0000000..335fefd --- /dev/null +++ b/tran/lpreson.h @@ -0,0 +1,3 @@ +sound_type snd_make_lpreson(sound_type x_snd, LVAL src, time_type frame_time); +sound_type snd_lpreson(sound_type x_snd, LVAL src, time_type frame_time); + /* LISP: (snd-lpreson SOUND ANY ANYNUM) */ diff --git a/tran/maxv.alg b/tran/maxv.alg new file mode 100644 index 0000000..d800921 --- /dev/null +++ b/tran/maxv.alg @@ -0,0 +1,11 @@ +(MAXV-ALG + (NAME "maxv") + (ARGUMENTS ("sound_type" "s1") ("sound_type" "s2")) + (ALWAYS-SCALE s1 s2) + (START (MAX s1 s2)) + (INNER-LOOP "double x1 = s1; + double x2 = s2; + output = (sample_type) (x1 > x2 ? x1 : x2)") + (TERMINATE (MIN s1 s2)) + (LOGICAL-STOP (MIN s1 s2)) +) diff --git a/tran/maxv.c b/tran/maxv.c new file mode 100644 index 0000000..a313b2e --- /dev/null +++ b/tran/maxv.c @@ -0,0 +1,235 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "maxv.h" + +void maxv_free(); + + +typedef struct maxv_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type s2; + long s2_cnt; + sample_block_values_type s2_ptr; +} maxv_susp_node, *maxv_susp_type; + + +void maxv_ss_fetch(register maxv_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 s2_scale_reg = susp->s2->scale; + register sample_block_values_type s2_ptr_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "maxv_ss_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the s2 input sample block: */ + susp_check_term_log_samples(s2, s2_ptr, s2_cnt); + togo = min(togo, susp->s2_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; + s2_ptr_reg = susp->s2_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +double x1 = (s1_scale_reg * *s1_ptr_reg++); + double x2 = (s2_scale_reg * *s2_ptr_reg++); + *out_ptr_reg++ = (sample_type) (x1 > x2 ? x1 : x2); + } while (--n); /* inner loop */ + + /* using s2_ptr_reg is a bad idea on RS/6000: */ + susp->s2_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(s2_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; + } +} /* maxv_ss_fetch */ + + +void maxv_toss_fetch(susp, snd_list) + register maxv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from s2 up to final_time for this block of zeros */ + while ((round((final_time - susp->s2->t0) * susp->s2->sr)) >= + susp->s2->current) + susp_get_samples(s2, s2_ptr, s2_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->s2->t0) * susp->s2->sr - + (susp->s2->current - susp->s2_cnt)); + susp->s2_ptr += n; + susp_took(s2_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void maxv_mark(maxv_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->s2); +} + + +void maxv_free(maxv_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->s2); + ffree_generic(susp, sizeof(maxv_susp_node), "maxv_free"); +} + + +void maxv_print_tree(maxv_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("s2:"); + sound_print_tree_1(susp->s2, n); +} + + +sound_type snd_make_maxv(sound_type s1, sound_type s2) +{ + register maxv_susp_type susp; + rate_type sr = max(s1->sr, s2->sr); + time_type t0 = max(s1->t0, s2->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + long lsc; + falloc_generic(susp, maxv_susp_node, "snd_make_maxv"); + susp->susp.fetch = maxv_ss_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < s2->t0) sound_prepend_zeros(s2, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(s2->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 = maxv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = maxv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = maxv_mark; + susp->susp.print_tree = maxv_print_tree; + susp->susp.name = "maxv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + lsc = logical_stop_cnt_cvt(s2); + if (susp->susp.log_stop_cnt > lsc) + susp->susp.log_stop_cnt = lsc; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->s2 = s2; + susp->s2_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_maxv(sound_type s1, sound_type s2) +{ + sound_type s1_copy = sound_copy(s1); + sound_type s2_copy = sound_copy(s2); + return snd_make_maxv(s1_copy, s2_copy); +} diff --git a/tran/maxv.h b/tran/maxv.h new file mode 100644 index 0000000..327b80a --- /dev/null +++ b/tran/maxv.h @@ -0,0 +1,3 @@ +sound_type snd_make_maxv(sound_type s1, sound_type s2); +sound_type snd_maxv(sound_type s1, sound_type s2); + /* LISP: (snd-maxv SOUND SOUND) */ diff --git a/tran/offset.alg b/tran/offset.alg new file mode 100644 index 0000000..316628e --- /dev/null +++ b/tran/offset.alg @@ -0,0 +1,11 @@ +(SCALE-ALG + (NAME "offset") + (ARGUMENTS ("sound_type" "s1") ("double" "offset")) + (STATE ("sample_type" "offset" "(sample_type) offset")) + (CONSTANT "offset") + (START (MIN s1)) + (INNER-LOOP "output = s1 + offset") + (TERMINATE (MIN s1)) + (LOGICAL-STOP (MIN s1)) +) + diff --git a/tran/offset.c b/tran/offset.c new file mode 100644 index 0000000..9d62b1e --- /dev/null +++ b/tran/offset.c @@ -0,0 +1,299 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "offset.h" + +void offset_free(); + + +typedef struct offset_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + + sample_type offset; +} offset_susp_node, *offset_susp_type; + + +void offset_n_fetch(register offset_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 offset_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "offset_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + offset_reg = susp->offset; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = *s1_ptr_reg++ + offset_reg; + } while (--n); /* inner loop */ + + /* using s1_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 */ + + /* 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; + } +} /* offset_n_fetch */ + + +void offset_s_fetch(register offset_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 offset_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "offset_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + offset_reg = susp->offset; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (s1_scale_reg * *s1_ptr_reg++) + offset_reg; + } while (--n); /* inner loop */ + + /* using s1_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 */ + + /* 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; + } +} /* offset_s_fetch */ + + +void offset_toss_fetch(susp, snd_list) + register offset_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void offset_mark(offset_susp_type susp) +{ + sound_xlmark(susp->s1); +} + + +void offset_free(offset_susp_type susp) +{ + sound_unref(susp->s1); + ffree_generic(susp, sizeof(offset_susp_node), "offset_free"); +} + + +void offset_print_tree(offset_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); +} + + +sound_type snd_make_offset(sound_type s1, double offset) +{ + register offset_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = s1->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, offset_susp_node, "snd_make_offset"); + susp->offset = (sample_type) offset; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = offset_n_fetch; break; + case INTERP_s: susp->susp.fetch = offset_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->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 = offset_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = offset_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = offset_mark; + susp->susp.print_tree = offset_print_tree; + susp->susp.name = "offset"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_offset(sound_type s1, double offset) +{ + sound_type s1_copy = sound_copy(s1); + return snd_make_offset(s1_copy, offset); +} diff --git a/tran/offset.h b/tran/offset.h new file mode 100644 index 0000000..5b08433 --- /dev/null +++ b/tran/offset.h @@ -0,0 +1,3 @@ +sound_type snd_make_offset(sound_type s1, double offset); +sound_type snd_offset(sound_type s1, double offset); + /* LISP: (snd-offset SOUND ANYNUM) */ diff --git a/tran/oneshot.alg b/tran/oneshot.alg new file mode 100644 index 0000000..a90282e --- /dev/null +++ b/tran/oneshot.alg @@ -0,0 +1,16 @@ +(ONESHOT-ALG + (NAME "oneshot") + (ARGUMENTS ("sound_type" "input") ("double" "level") ("double" "ontime")) + ; (INTERNAL-SCALING input) ; scale factor not handled in level because scale could be negative + (STATE ("double" "lev" "level") + ("long" "oncount" "round(ontime * input->sr)") + ("long" "cnt" "0")) + (START (MIN input)) + (INNER-LOOP " double x = input; + if (x > lev) cnt = oncount; + cnt--; + output = (cnt >= 0 ? 1.0F : 0.0F);") + (CONSTANT "lev" "oncount") + (TERMINATE (MIN input)) + (LOGICAL-STOP (MIN input)) +) diff --git a/tran/oneshot.c b/tran/oneshot.c new file mode 100644 index 0000000..9b880ba --- /dev/null +++ b/tran/oneshot.c @@ -0,0 +1,319 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "oneshot.h" + +void oneshot_free(); + + +typedef struct oneshot_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + double lev; + long oncount; + long cnt; +} oneshot_susp_node, *oneshot_susp_type; + + +void oneshot_n_fetch(register oneshot_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 double lev_reg; + register long oncount_reg; + register long cnt_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "oneshot_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + lev_reg = susp->lev; + oncount_reg = susp->oncount; + cnt_reg = susp->cnt; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double x = *input_ptr_reg++; + if (x > lev_reg) cnt_reg = oncount_reg; + cnt_reg--; + *out_ptr_reg++ = (cnt_reg >= 0 ? 1.0F : 0.0F);; + } while (--n); /* inner loop */ + + susp->cnt = cnt_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* oneshot_n_fetch */ + + +void oneshot_s_fetch(register oneshot_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 double lev_reg; + register long oncount_reg; + register long cnt_reg; + register sample_type input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "oneshot_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + lev_reg = susp->lev; + oncount_reg = susp->oncount; + cnt_reg = susp->cnt; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double x = (input_scale_reg * *input_ptr_reg++); + if (x > lev_reg) cnt_reg = oncount_reg; + cnt_reg--; + *out_ptr_reg++ = (cnt_reg >= 0 ? 1.0F : 0.0F);; + } while (--n); /* inner loop */ + + susp->cnt = cnt_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* oneshot_s_fetch */ + + +void oneshot_toss_fetch(susp, snd_list) + register oneshot_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void oneshot_mark(oneshot_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void oneshot_free(oneshot_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(oneshot_susp_node), "oneshot_free"); +} + + +void oneshot_print_tree(oneshot_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_oneshot(sound_type input, double level, double ontime) +{ + register oneshot_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, oneshot_susp_node, "snd_make_oneshot"); + susp->lev = level; + susp->oncount = round(ontime * input->sr); + susp->cnt = 0; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(input, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = oneshot_n_fetch; break; + case INTERP_s: susp->susp.fetch = oneshot_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = oneshot_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = oneshot_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = oneshot_mark; + susp->susp.print_tree = oneshot_print_tree; + susp->susp.name = "oneshot"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_oneshot(sound_type input, double level, double ontime) +{ + sound_type input_copy = sound_copy(input); + return snd_make_oneshot(input_copy, level, ontime); +} diff --git a/tran/oneshot.h b/tran/oneshot.h new file mode 100644 index 0000000..9a13225 --- /dev/null +++ b/tran/oneshot.h @@ -0,0 +1,3 @@ +sound_type snd_make_oneshot(sound_type input, double level, double ontime); +sound_type snd_oneshot(sound_type input, double level, double ontime); + /* LISP: (snd-oneshot SOUND ANYNUM ANYNUM) */ diff --git a/tran/osc.alg b/tran/osc.alg new file mode 100644 index 0000000..3705098 --- /dev/null +++ b/tran/osc.alg @@ -0,0 +1,31 @@ +(OSC-ALG +(NAME "osc") +(ARGUMENTS ("sound_type" "input") ("double" "step") ("rate_type" "sr") + ("double" "hz") ("time_type" "t0") ("time_type" "d") + ("double" "phase")) +(TABLE "input") +(NOT-IN-INNER-LOOP "input") +(STATE + ("double" "ph_incr" "0") + ("table_type" "the_table" "sound_to_table(input)") + ("sample_type *" "table_ptr" "susp->the_table->samples") + ("double" "table_len" "susp->the_table->length") + ("double" "phase" "compute_phase(phase, step, (long) susp->table_len, + input->sr, sr, hz, &susp->ph_incr)") ) +; "((hz * susp->table_len) / sr)") +(TERMINATE (AFTER "d")) +(INNER-LOOP " + long table_index = (long) phase; + double x1 = table_ptr[table_index]; + output = (sample_type) (x1 + (phase - table_index) * + (table_ptr[table_index + 1] - x1)); + phase += ph_incr; + while (phase >= table_len) phase -= table_len; +") +(CONSTANT "ph_incr" "table_len" "table_ptr") + +(SAMPLE-RATE "sr") +(FINALIZATION " table_unref(susp->the_table); +") +) + diff --git a/tran/osc.c b/tran/osc.c new file mode 100644 index 0000000..c2e7ce5 --- /dev/null +++ b/tran/osc.c @@ -0,0 +1,133 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "osc.h" + +void osc_free(); + + +typedef struct osc_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + double ph_incr; + table_type the_table; + sample_type *table_ptr; + double table_len; + double phase; +} osc_susp_node, *osc_susp_type; + + +void osc__fetch(register osc_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 double ph_incr_reg; + register sample_type * table_ptr_reg; + register double table_len_reg; + register double phase_reg; + falloc_sample_block(out, "osc__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; + } + + n = togo; + ph_incr_reg = susp->ph_incr; + table_ptr_reg = susp->table_ptr; + table_len_reg = susp->table_len; + phase_reg = susp->phase; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + long table_index = (long) phase_reg; + double x1 = table_ptr_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)); + phase_reg += ph_incr_reg; + while (phase_reg >= table_len_reg) phase_reg -= table_len_reg; +; + } while (--n); /* inner loop */ + + susp->phase = phase_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; + } +} /* osc__fetch */ + + +void osc_free(osc_susp_type susp) +{ + table_unref(susp->the_table); + ffree_generic(susp, sizeof(osc_susp_node), "osc_free"); +} + + +void osc_print_tree(osc_susp_type susp, int n) +{ +} + + +sound_type snd_make_osc(sound_type input, double step, rate_type sr, double hz, time_type t0, time_type d, double phase) +{ + register osc_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, osc_susp_node, "snd_make_osc"); + susp->ph_incr = 0; + susp->the_table = sound_to_table(input); + susp->table_ptr = susp->the_table->samples; + susp->table_len = susp->the_table->length; + susp->phase = compute_phase(phase, step, (long) susp->table_len, + input->sr, sr, hz, &susp->ph_incr); + susp->susp.fetch = osc__fetch; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = osc_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = osc_print_tree; + susp->susp.name = "osc"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_osc(sound_type input, double step, rate_type sr, double hz, time_type t0, time_type d, double phase) +{ + return snd_make_osc(input, step, sr, hz, t0, d, phase); +} diff --git a/tran/osc.h b/tran/osc.h new file mode 100644 index 0000000..acf3a6e --- /dev/null +++ b/tran/osc.h @@ -0,0 +1,3 @@ +sound_type snd_make_osc(sound_type input, double step, rate_type sr, double hz, time_type t0, time_type d, double phase); +sound_type snd_osc(sound_type input, double step, rate_type sr, double hz, time_type t0, time_type d, double phase); + /* LISP: (snd-osc SOUND ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/partial.alg b/tran/partial.alg new file mode 100644 index 0000000..45a1999 --- /dev/null +++ b/tran/partial.alg @@ -0,0 +1,20 @@ +(PARTIAL-ALG +(NAME "partial") +(ARGUMENTS ("rate_type" "sr") ("double" "hz") ("sound_type" "env")) +(SUPPORT-FUNCTIONS " +#include \"sine.h\" +") +(START (MIN env)) +(STATE ("long" "phase" "0") + ("long" "ph_incr" "round((hz * SINE_TABLE_LEN) * (1 << SINE_TABLE_SHIFT) / sr)")) +(TERMINATE (MIN env)) +(LOGICAL-STOP (MIN env)) +(INNER-LOOP "output = sine_table[phase >> SINE_TABLE_SHIFT] * env; + phase += ph_incr; + phase &= SINE_TABLE_MASK;") +(MAINTAIN ("phase" + "susp->phase = (susp->phase + susp->ph_incr * togo) & SINE_TABLE_MASK")) +(CONSTANT "ph_incr") +(SAMPLE-RATE "sr") +) + diff --git a/tran/partial.c b/tran/partial.c new file mode 100644 index 0000000..4550f33 --- /dev/null +++ b/tran/partial.c @@ -0,0 +1,314 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "partial.h" + +void partial_free(); + + +typedef struct partial_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type env; + long env_cnt; + sample_block_values_type env_ptr; + + long phase; + long ph_incr; +} partial_susp_node, *partial_susp_type; + + +#include "sine.h" + + +void partial_n_fetch(register partial_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 long phase_reg; + register long ph_incr_reg; + register sample_block_values_type env_ptr_reg; + falloc_sample_block(out, "partial_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 env input sample block: */ + susp_check_term_log_samples(env, env_ptr, env_cnt); + togo = min(togo, susp->env_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; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + env_ptr_reg = susp->env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = sine_table[phase_reg >> SINE_TABLE_SHIFT] * *env_ptr_reg++; + phase_reg += ph_incr_reg; + phase_reg &= SINE_TABLE_MASK;; + } while (--n); /* inner loop */ + + susp->phase = (susp->phase + susp->ph_incr * togo) & SINE_TABLE_MASK; + /* using env_ptr_reg is a bad idea on RS/6000: */ + susp->env_ptr += togo; + out_ptr += togo; + susp_took(env_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; + } +} /* partial_n_fetch */ + + +void partial_s_fetch(register partial_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 long phase_reg; + register long ph_incr_reg; + register sample_type env_scale_reg = susp->env->scale; + register sample_block_values_type env_ptr_reg; + falloc_sample_block(out, "partial_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 env input sample block: */ + susp_check_term_log_samples(env, env_ptr, env_cnt); + togo = min(togo, susp->env_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; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + env_ptr_reg = susp->env_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = sine_table[phase_reg >> SINE_TABLE_SHIFT] * (env_scale_reg * *env_ptr_reg++); + phase_reg += ph_incr_reg; + phase_reg &= SINE_TABLE_MASK;; + } while (--n); /* inner loop */ + + susp->phase = (susp->phase + susp->ph_incr * togo) & SINE_TABLE_MASK; + /* using env_ptr_reg is a bad idea on RS/6000: */ + susp->env_ptr += togo; + out_ptr += togo; + susp_took(env_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; + } +} /* partial_s_fetch */ + + +void partial_toss_fetch(susp, snd_list) + register partial_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from env up to final_time for this block of zeros */ + while ((round((final_time - susp->env->t0) * susp->env->sr)) >= + susp->env->current) + susp_get_samples(env, env_ptr, env_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->env->t0) * susp->env->sr - + (susp->env->current - susp->env_cnt)); + susp->env_ptr += n; + susp_took(env_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void partial_mark(partial_susp_type susp) +{ + sound_xlmark(susp->env); +} + + +void partial_free(partial_susp_type susp) +{ + sound_unref(susp->env); + ffree_generic(susp, sizeof(partial_susp_node), "partial_free"); +} + + +void partial_print_tree(partial_susp_type susp, int n) +{ + indent(n); + stdputstr("env:"); + sound_print_tree_1(susp->env, n); +} + + +sound_type snd_make_partial(rate_type sr, double hz, sound_type env) +{ + register partial_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = env->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, partial_susp_node, "snd_make_partial"); + susp->phase = 0; + susp->ph_incr = round((hz * SINE_TABLE_LEN) * (1 << SINE_TABLE_SHIFT) / sr); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(env, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = partial_n_fetch; break; + case INTERP_s: susp->susp.fetch = partial_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < env->t0) sound_prepend_zeros(env, t0); + /* minimum start time over all inputs: */ + t0_min = min(env->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 = partial_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = partial_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = partial_mark; + susp->susp.print_tree = partial_print_tree; + susp->susp.name = "partial"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(env); + susp->susp.current = 0; + susp->env = env; + susp->env_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_partial(rate_type sr, double hz, sound_type env) +{ + sound_type env_copy = sound_copy(env); + return snd_make_partial(sr, hz, env_copy); +} diff --git a/tran/partial.h b/tran/partial.h new file mode 100644 index 0000000..7b9858e --- /dev/null +++ b/tran/partial.h @@ -0,0 +1,3 @@ +sound_type snd_make_partial(rate_type sr, double hz, sound_type env); +sound_type snd_partial(rate_type sr, double hz, sound_type env); + /* LISP: (snd-partial ANYNUM ANYNUM SOUND) */ diff --git a/tran/pluck.alg b/tran/pluck.alg new file mode 100644 index 0000000..6bd342f --- /dev/null +++ b/tran/pluck.alg @@ -0,0 +1,144 @@ +;; PLUCK.ALG is based on the Pluck.t instrument from M4C +;; +; to assist with debugging, here are some calculated parameters +; dumped from a run of M4C: +; +; Setup Pluck at t= 6.000 +; DUR= 1.000, pitch= 8.060, amp= 10000, DB_drop= 60.0, rfrac=0.00 +; freq 369.995 +; freq = 369.995361 +; Final = 1000.000000, t= 0.052715, y = 0.000000, lF = 6.907755 +; tdecay = 13.430565, sT = 369.995361, rho = 0.982869, stretch = 0.500000 +; N = 59, x = 0.095342, cons = 0.825914 +; x2 0.412957 x3 0.912957 stretch 0.5 cons 0.825914 SR 22050 +; complete Pluck setup +;; + +(PLUCK-ALG +(NAME "pluck") +(ARGUMENTS ("rate_type" "sr") ("double" "hz") ("time_type" "t0") + ("time_type" "d") ("double" "final_amp")) +(SUPPORT-FUNCTIONS " +#define MAXLENGTH 20000 + +long pluck_parameters(double hz, double sr, double final, double dur, + double *stretch, double *cons, double *rho) +{ + double t = PI * (hz / sr); + double y = fabs(cos(t)); + /* original m4c code used ratio of initial amp to final amp in dB + and then converted to a ratio, e.g. you specify 60 and the + parameter Final is 1000.0. This is counterintuitive to me (RBD) + because I would expect the value to be -60dB or 0.001. That is + what I implemented, so to get this back into correspondence + with the m4c algorithm, I take the NEGATIVE log to get lf, + whereas m4c takes the positive log: + */ + double lf = -log(final); + double tdecay = -lf / (hz * log(y)); + double st; + long len; + double x; + + if (hz <= sr / MAXLENGTH) { + xlfail(\"pluck hz is too low\"); + } else if (hz >= sr / 3) { + xlfail(\"pluck hz is too high\"); + } + /* + * if desired decay time is shorter than the natural decay time, + * then introduce a loss factor. Otherwise, stretch note out. + */ + st = hz * dur; + if (dur < tdecay) { + *rho = exp(-lf / st) / y; + *stretch = 0.5; + } else { + *rho = 1; + *stretch = 0.5 + sqrt(0.25 - + (1 - exp(2 * lf * (hz - sr) / (st * sr))) / + (2 - 2 * cos(2 * t))); + } + + /* delay line length is */ + len = (int) ((sr / hz) - *stretch - 0.001); + + /* tuning constant is */ + x = (sr / hz) - len - *stretch; + *cons = (1.0 - x) / (1.0 + x); + + if (len <= 1) { + xlfail(\"internal error: pluck delay line length too short\"); + } + return len; +} + +static unsigned int rnext = 1; +int krand() +{ + rnext = rnext * 1103515245 + 12345; + return (rnext >> 16) & 0x7fff; +} + +void pluck_initialize(sample_type *shiftreg, sample_type *array, + long len, double cons) +{ + sample_type suma = 0.0F; + long k; + sample_type avea; + array[1] = 0; + for (k = len; k > 0; k--, array--) { + /* note: the m4c code has a bug. It claims to filter + the initial values, but it really just sets the + values to +1 or -1. The following does the same + thing with much less code: + */ + *array = (krand() & 2) - 1; + suma += *array; /* compute sum for the average */ + } + avea = suma / len; + /* zero the average */ + for (k = 0; k <= len + 1; k++) shiftreg[k] -= avea; + shiftreg[len] = 0; + shiftreg[len + 1] = 0; +}") +(STATE ("double" "stretch" "0") + ("double" "cons" "0") + ("double" "loss" "0") + ("long" "len" "pluck_parameters(hz, sr, final_amp, d, + &susp->stretch, &susp->cons, + &susp->loss)") + ("double" "x2" "-susp->cons * (susp->stretch - 1)") + ("double" "x3" "susp->cons * susp->stretch - susp->stretch + 1") + ("sample_type *" "shiftreg" + ;; I think susp->len + 2 is the correct value, but I use +4 to be safe + "(sample_type *) calloc (susp->len + 4, sizeof(sample_type))") + ("sample_type *" "i1" "susp->shiftreg + susp->len + 1") + ("sample_type *" "i2" "susp->shiftreg + susp->len") + ("sample_type *" "i3" "susp->shiftreg + susp->len - 1") + ("sample_type *" "i4" "susp->shiftreg + susp->len - 2") + ("sample_type *" "endptr" "susp->shiftreg + susp->len + 2; + pluck_initialize(susp->shiftreg, susp->i3, + susp->len, susp->cons)")) +(CONSTANT "stretch" "cons" "loss" "len" "x2" "x3" "endptr") +(SAMPLE-RATE "sr") +(NOT-REGISTER shiftreg) +(TERMINATE (AFTER "d")) +(INNER-LOOP " sample_type sum = (sample_type) + ((*i1++ * x2) + (*i2++ * x3) + + (*i3++ * stretch) - (*i4++ * cons)); + /* wrap pointers around shift register if necessary */ + if (i1 == endptr) i1 = susp->shiftreg; + if (i2 == endptr) i2 = susp->shiftreg; + if (i3 == endptr) i3 = susp->shiftreg; + if (i4 == endptr) i4 = susp->shiftreg; + + /* store new value in shift register */ + *i4 = (sample_type) (sum * loss); + + /* deliver sample */ + output = sum; +") +(FINALIZATION " free(susp->shiftreg);\n") +) + diff --git a/tran/pluck.c b/tran/pluck.c new file mode 100644 index 0000000..267e98c --- /dev/null +++ b/tran/pluck.c @@ -0,0 +1,256 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "pluck.h" + +void pluck_free(); + + +typedef struct pluck_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + double stretch; + double cons; + double loss; + long len; + double x2; + double x3; + sample_type *shiftreg; + sample_type *i1; + sample_type *i2; + sample_type *i3; + sample_type *i4; + sample_type *endptr; +} pluck_susp_node, *pluck_susp_type; + + +#define MAXLENGTH 20000 + +long pluck_parameters(double hz, double sr, double final, double dur, + double *stretch, double *cons, double *rho) +{ + double t = PI * (hz / sr); + double y = fabs(cos(t)); + /* original m4c code used ratio of initial amp to final amp in dB + and then converted to a ratio, e.g. you specify 60 and the + parameter Final is 1000.0. This is counterintuitive to me (RBD) + because I would expect the value to be -60dB or 0.001. That is + what I implemented, so to get this back into correspondence + with the m4c algorithm, I take the NEGATIVE log to get lf, + whereas m4c takes the positive log: + */ + double lf = -log(final); + double tdecay = -lf / (hz * log(y)); + double st; + long len; + double x; + + if (hz <= sr / MAXLENGTH) { + xlfail("pluck hz is too low"); + } else if (hz >= sr / 3) { + xlfail("pluck hz is too high"); + } + /* + * if desired decay time is shorter than the natural decay time, + * then introduce a loss factor. Otherwise, stretch note out. + */ + st = hz * dur; + if (dur < tdecay) { + *rho = exp(-lf / st) / y; + *stretch = 0.5; + } else { + *rho = 1; + *stretch = 0.5 + sqrt(0.25 - + (1 - exp(2 * lf * (hz - sr) / (st * sr))) / + (2 - 2 * cos(2 * t))); + } + + /* delay line length is */ + len = (int) ((sr / hz) - *stretch - 0.001); + + /* tuning constant is */ + x = (sr / hz) - len - *stretch; + *cons = (1.0 - x) / (1.0 + x); + + if (len <= 1) { + xlfail("internal error: pluck delay line length too short"); + } + return len; +} + +static unsigned int rnext = 1; +int krand() +{ + rnext = rnext * 1103515245 + 12345; + return (rnext >> 16) & 0x7fff; +} + +void pluck_initialize(sample_type *shiftreg, sample_type *array, + long len, double cons) +{ + sample_type suma = 0.0F; + long k; + sample_type avea; + array[1] = 0; + for (k = len; k > 0; k--, array--) { + /* note: the m4c code has a bug. It claims to filter + the initial values, but it really just sets the + values to +1 or -1. The following does the same + thing with much less code: + */ + *array = (krand() & 2) - 1; + suma += *array; /* compute sum for the average */ + } + avea = suma / len; + /* zero the average */ + for (k = 0; k <= len + 1; k++) shiftreg[k] -= avea; + shiftreg[len] = 0; + shiftreg[len + 1] = 0; +} + +void pluck__fetch(register pluck_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 double stretch_reg; + register double cons_reg; + register double loss_reg; + register double x2_reg; + register double x3_reg; + register sample_type * i1_reg; + register sample_type * i2_reg; + register sample_type * i3_reg; + register sample_type * i4_reg; + register sample_type * endptr_reg; + falloc_sample_block(out, "pluck__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; + } + + n = togo; + stretch_reg = susp->stretch; + cons_reg = susp->cons; + loss_reg = susp->loss; + x2_reg = susp->x2; + x3_reg = susp->x3; + i1_reg = susp->i1; + i2_reg = susp->i2; + i3_reg = susp->i3; + i4_reg = susp->i4; + endptr_reg = susp->endptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + sample_type sum = (sample_type) + ((*i1_reg++ * x2_reg) + (*i2_reg++ * x3_reg) + + (*i3_reg++ * stretch_reg) - (*i4_reg++ * cons_reg)); + /* wrap pointers around shift register if necessary */ + if (i1_reg == endptr_reg) i1_reg = susp->shiftreg; + if (i2_reg == endptr_reg) i2_reg = susp->shiftreg; + if (i3_reg == endptr_reg) i3_reg = susp->shiftreg; + if (i4_reg == endptr_reg) i4_reg = susp->shiftreg; + + /* store new value in shift register */ + *i4_reg = (sample_type) (sum * loss_reg); + + /* deliver sample */ + *out_ptr_reg++ = sum; +; + } while (--n); /* inner loop */ + + susp->i1 = i1_reg; + susp->i2 = i2_reg; + susp->i3 = i3_reg; + susp->i4 = i4_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; + } +} /* pluck__fetch */ + + +void pluck_free(pluck_susp_type susp) +{ + free(susp->shiftreg); + ffree_generic(susp, sizeof(pluck_susp_node), "pluck_free"); +} + + +void pluck_print_tree(pluck_susp_type susp, int n) +{ +} + + +sound_type snd_make_pluck(rate_type sr, double hz, time_type t0, time_type d, double final_amp) +{ + register pluck_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, pluck_susp_node, "snd_make_pluck"); + susp->stretch = 0; + susp->cons = 0; + susp->loss = 0; + susp->len = pluck_parameters(hz, sr, final_amp, d, + &susp->stretch, &susp->cons, + &susp->loss); + susp->x2 = -susp->cons * (susp->stretch - 1); + susp->x3 = susp->cons * susp->stretch - susp->stretch + 1; + susp->shiftreg = (sample_type *) calloc (susp->len + 4, sizeof(sample_type)); + susp->i1 = susp->shiftreg + susp->len + 1; + susp->i2 = susp->shiftreg + susp->len; + susp->i3 = susp->shiftreg + susp->len - 1; + susp->i4 = susp->shiftreg + susp->len - 2; + susp->endptr = susp->shiftreg + susp->len + 2; + pluck_initialize(susp->shiftreg, susp->i3, + susp->len, susp->cons); + susp->susp.fetch = pluck__fetch; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = pluck_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = pluck_print_tree; + susp->susp.name = "pluck"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_pluck(rate_type sr, double hz, time_type t0, time_type d, double final_amp) +{ + return snd_make_pluck(sr, hz, t0, d, final_amp); +} diff --git a/tran/pluck.h b/tran/pluck.h new file mode 100644 index 0000000..36be409 --- /dev/null +++ b/tran/pluck.h @@ -0,0 +1,3 @@ +sound_type snd_make_pluck(rate_type sr, double hz, time_type t0, time_type d, double final_amp); +sound_type snd_pluck(rate_type sr, double hz, time_type t0, time_type d, double final_amp); + /* LISP: (snd-pluck ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/prod.alg b/tran/prod.alg new file mode 100644 index 0000000..1a36c04 --- /dev/null +++ b/tran/prod.alg @@ -0,0 +1,11 @@ +(PROD-ALG + (NAME "prod") + (ARGUMENTS ("sound_type" "s1") ("sound_type" "s2")) + (START (MAX s1 s2)) + (COMMUTATIVE (s1 s2)) + (INNER-LOOP "output = s1 * s2") + (LINEAR s1 s2) + (TERMINATE (MIN s1 s2)) + (LOGICAL-STOP (MIN s1 s2)) +) + diff --git a/tran/prod.c b/tran/prod.c new file mode 100644 index 0000000..dc2be08 --- /dev/null +++ b/tran/prod.c @@ -0,0 +1,244 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "prod.h" + +void prod_free(); + + +typedef struct prod_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type s2; + long s2_cnt; + sample_block_values_type s2_ptr; +} prod_susp_node, *prod_susp_type; + + +void prod_nn_fetch(register prod_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 s2_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "prod_nn_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the s2 input sample block: */ + susp_check_term_log_samples(s2, s2_ptr, s2_cnt); + togo = min(togo, susp->s2_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; + s2_ptr_reg = susp->s2_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = *s1_ptr_reg++ * *s2_ptr_reg++; + } while (--n); /* inner loop */ + + /* using s2_ptr_reg is a bad idea on RS/6000: */ + susp->s2_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(s2_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; + } +} /* prod_nn_fetch */ + + +void prod_toss_fetch(susp, snd_list) + register prod_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from s2 up to final_time for this block of zeros */ + while ((round((final_time - susp->s2->t0) * susp->s2->sr)) >= + susp->s2->current) + susp_get_samples(s2, s2_ptr, s2_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->s2->t0) * susp->s2->sr - + (susp->s2->current - susp->s2_cnt)); + susp->s2_ptr += n; + susp_took(s2_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void prod_mark(prod_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->s2); +} + + +void prod_free(prod_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->s2); + ffree_generic(susp, sizeof(prod_susp_node), "prod_free"); +} + + +void prod_print_tree(prod_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("s2:"); + sound_print_tree_1(susp->s2, n); +} + + +sound_type snd_make_prod(sound_type s1, sound_type s2) +{ + register prod_susp_type susp; + rate_type sr = max(s1->sr, s2->sr); + time_type t0 = max(s1->t0, s2->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + long lsc; + /* sort commutative signals: (S1 S2) */ + snd_sort_2(&s1, &s2, sr); + + /* combine scale factors of linear inputs (S1 S2) */ + scale_factor *= s1->scale; + s1->scale = 1.0F; + scale_factor *= s2->scale; + s2->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (s1->sr < sr) { s1->scale = scale_factor; scale_factor = 1.0F; } + else if (s2->sr < sr) { s2->scale = scale_factor; scale_factor = 1.0F; } + + falloc_generic(susp, prod_susp_node, "snd_make_prod"); + susp->susp.fetch = prod_nn_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < s2->t0) sound_prepend_zeros(s2, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(s2->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 = prod_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = prod_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = prod_mark; + susp->susp.print_tree = prod_print_tree; + susp->susp.name = "prod"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + lsc = logical_stop_cnt_cvt(s2); + if (susp->susp.log_stop_cnt > lsc) + susp->susp.log_stop_cnt = lsc; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->s2 = s2; + susp->s2_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_prod(sound_type s1, sound_type s2) +{ + sound_type s1_copy = sound_copy(s1); + sound_type s2_copy = sound_copy(s2); + return snd_make_prod(s1_copy, s2_copy); +} diff --git a/tran/prod.h b/tran/prod.h new file mode 100644 index 0000000..127b7f9 --- /dev/null +++ b/tran/prod.h @@ -0,0 +1,3 @@ +sound_type snd_make_prod(sound_type s1, sound_type s2); +sound_type snd_prod(sound_type s1, sound_type s2); + /* LISP: (snd-prod SOUND SOUND) */ diff --git a/tran/pwl.alg b/tran/pwl.alg new file mode 100644 index 0000000..e9f66db --- /dev/null +++ b/tran/pwl.alg @@ -0,0 +1,82 @@ +(PWL-ALG + (NAME "pwl") + (ARGUMENTS ("time_type" "t0") ("rate_type" "sr") ("LVAL" "lis")) + (SUPPORT-FUNCTIONS " +/* IMPLEMENTATION NOTE: + * The lis argument is a list of alternating sample numbers and values + * which are taken in pairs, with an implicit (0, 0) starting point. The + * last point is a sample number only, the value being implicitly 0. + * The bpt_ptr points to the next sample number in the list. + * The incr is set to the increment per sample, and lvl is the next + * sample value. + * + * The list is assumed to be well-formed, so it should be checked by + * the caller (users should not call this directly). + */ + + +/* compute_lvl -- setup the susp with level, advance bpt_ptr */ +/* + * returns true if it is time to terminate + * + * Note: compute_lvl gets called in the outer loop to skip over + * a breakpoint pair before starting the compute_incr loop, which + * searches for a breakpoint that is some number of samples in the + * future. This code is not embedded in compute_incr because it is + * NOT called from the initialization, where it would be wrong to + * skip over the first breakpoint. + */ +boolean compute_lvl(pwl_susp_type susp) +{ + if (!cdr(susp->bpt_ptr)) return true; + susp->lvl = getflonum(car(cdr(susp->bpt_ptr))); + susp->bpt_ptr = cdr(cdr(susp->bpt_ptr)); + return !susp->bpt_ptr; +} + + +/* compute_incr -- setup the susp with level and increment */ +/* + * returns true if it is time to terminate + */ +boolean compute_incr(pwl_susp_type susp, long *n, long cur) +{ + double target; + while (*n == 0) { + *n = getfixnum(car(susp->bpt_ptr)) - cur; + /* if there is a 2nd element of the pair, get the target */ + if (cdr(susp->bpt_ptr)) + target = getflonum(car(cdr(susp->bpt_ptr))); + else target = 0.0; + if (*n > 0) susp->incr = (target - susp->lvl) / *n; + else if (compute_lvl(susp)) return true; + } + return false; +} +") + (SAMPLE-RATE "sr") + (STATE + ("LVAL" "bpt_ptr" "lis") + ("double" "incr" "0.0") + ("double" "lvl" "0.0; + { long temp = 0; compute_incr(susp, &temp, 0); }")) + + (OUTER-LOOP " + if (susp->bpt_ptr == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + { long cur = susp->susp.current + cnt; + long nn = getfixnum(car(susp->bpt_ptr)) - cur; + if (nn == 0) { + if (compute_lvl(susp) || compute_incr(susp, &nn, cur)) goto out; + } + togo = min(nn, togo); + } +") + (INNER-LOOP "output = (sample_type) lvl; lvl += incr;") + (MAINTAIN ("lvl" "susp->lvl += susp->incr * togo")) + (CONSTANT "incr") + (TERMINATE COMPUTED) +) + diff --git a/tran/pwl.c b/tran/pwl.c new file mode 100644 index 0000000..09681cd --- /dev/null +++ b/tran/pwl.c @@ -0,0 +1,180 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "pwl.h" + +void pwl_free(); + + +typedef struct pwl_susp_struct { + snd_susp_node susp; + + LVAL bpt_ptr; + double incr; + double lvl; +} pwl_susp_node, *pwl_susp_type; + + +/* IMPLEMENTATION NOTE: + * The lis argument is a list of alternating sample numbers and values + * which are taken in pairs, with an implicit (0, 0) starting point. The + * last point is a sample number only, the value being implicitly 0. + * The bpt_ptr points to the next sample number in the list. + * The incr is set to the increment per sample, and lvl is the next + * sample value. + * + * The list is assumed to be well-formed, so it should be checked by + * the caller (users should not call this directly). + */ + + +/* compute_lvl -- setup the susp with level, advance bpt_ptr */ +/* + * returns true if it is time to terminate + * + * Note: compute_lvl gets called in the outer loop to skip over + * a breakpoint pair before starting the compute_incr loop, which + * searches for a breakpoint that is some number of samples in the + * future. This code is not embedded in compute_incr because it is + * NOT called from the initialization, where it would be wrong to + * skip over the first breakpoint. + */ +boolean compute_lvl(pwl_susp_type susp) +{ + if (!cdr(susp->bpt_ptr)) return true; + susp->lvl = getflonum(car(cdr(susp->bpt_ptr))); + susp->bpt_ptr = cdr(cdr(susp->bpt_ptr)); + return !susp->bpt_ptr; +} + + +/* compute_incr -- setup the susp with level and increment */ +/* + * returns true if it is time to terminate + */ +boolean compute_incr(pwl_susp_type susp, long *n, long cur) +{ + double target; + while (*n == 0) { + *n = getfixnum(car(susp->bpt_ptr)) - cur; + /* if there is a 2nd element of the pair, get the target */ + if (cdr(susp->bpt_ptr)) + target = getflonum(car(cdr(susp->bpt_ptr))); + else target = 0.0; + if (*n > 0) susp->incr = (target - susp->lvl) / *n; + else if (compute_lvl(susp)) return true; + } + return false; +} + + +void pwl__fetch(register pwl_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 double incr_reg; + register double lvl_reg; + falloc_sample_block(out, "pwl__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; + + + if (susp->bpt_ptr == NULL) { +out: togo = 0; /* indicate termination */ + break; /* we're done */ + } + { long cur = susp->susp.current + cnt; + long nn = getfixnum(car(susp->bpt_ptr)) - cur; + if (nn == 0) { + if (compute_lvl(susp) || compute_incr(susp, &nn, cur)) goto out; + } + togo = min(nn, togo); + } + + n = togo; + incr_reg = susp->incr; + lvl_reg = susp->lvl; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) lvl_reg; lvl_reg += incr_reg;; + } while (--n); /* inner loop */ + + susp->lvl += susp->incr * togo; + 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; + } +} /* pwl__fetch */ + + +void pwl_mark(pwl_susp_type susp) +{ + if (susp->bpt_ptr) mark(susp->bpt_ptr); +} + + +void pwl_free(pwl_susp_type susp) +{ + ffree_generic(susp, sizeof(pwl_susp_node), "pwl_free"); +} + + +void pwl_print_tree(pwl_susp_type susp, int n) +{ +} + + +sound_type snd_make_pwl(time_type t0, rate_type sr, LVAL lis) +{ + register pwl_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, pwl_susp_node, "snd_make_pwl"); + susp->bpt_ptr = lis; + susp->incr = 0.0; + susp->lvl = 0.0; + { long temp = 0; compute_incr(susp, &temp, 0); }; + susp->susp.fetch = pwl__fetch; + + /* initialize susp state */ + susp->susp.free = pwl_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = pwl_mark; + susp->susp.print_tree = pwl_print_tree; + susp->susp.name = "pwl"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_pwl(time_type t0, rate_type sr, LVAL lis) +{ + return snd_make_pwl(t0, sr, lis); +} diff --git a/tran/pwl.h b/tran/pwl.h new file mode 100644 index 0000000..36700f6 --- /dev/null +++ b/tran/pwl.h @@ -0,0 +1,3 @@ +sound_type snd_make_pwl(time_type t0, rate_type sr, LVAL lis); +sound_type snd_pwl(time_type t0, rate_type sr, LVAL lis); + /* LISP: (snd-pwl ANYNUM ANYNUM ANY) */ diff --git a/tran/quantize.alg b/tran/quantize.alg new file mode 100644 index 0000000..fc268bd --- /dev/null +++ b/tran/quantize.alg @@ -0,0 +1,11 @@ +(QUANTIZE-ALG + (NAME "quantize") + (ARGUMENTS ("sound_type" "s1") ("long" "steps")) + (INTERNAL-SCALING s1) + (START (MIN s1)) + (STATE ("double" "factor" "s1->scale * steps; scale_factor = (sample_type) (1.0 / steps);")) + (INNER-LOOP "register long xx = (long) (s1 * factor); output = (float) xx;") + (TERMINATE (MIN s1)) + (CONSTANT "factor") + (LOGICAL-STOP (MIN s1)) +) diff --git a/tran/quantize.c b/tran/quantize.c new file mode 100644 index 0000000..cf919a6 --- /dev/null +++ b/tran/quantize.c @@ -0,0 +1,202 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "quantize.h" + +void quantize_free(); + + +typedef struct quantize_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + + double factor; +} quantize_susp_node, *quantize_susp_type; + + +void quantize_n_fetch(register quantize_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 double factor_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "quantize_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + factor_reg = susp->factor; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +register long xx = (long) (*s1_ptr_reg++ * factor_reg); *out_ptr_reg++ = (float) xx;; + } while (--n); /* inner loop */ + + /* using s1_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 */ + + /* 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; + } +} /* quantize_n_fetch */ + + +void quantize_toss_fetch(susp, snd_list) + register quantize_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void quantize_mark(quantize_susp_type susp) +{ + sound_xlmark(susp->s1); +} + + +void quantize_free(quantize_susp_type susp) +{ + sound_unref(susp->s1); + ffree_generic(susp, sizeof(quantize_susp_node), "quantize_free"); +} + + +void quantize_print_tree(quantize_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); +} + + +sound_type snd_make_quantize(sound_type s1, long steps) +{ + register quantize_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = s1->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, quantize_susp_node, "snd_make_quantize"); + susp->factor = s1->scale * steps; scale_factor = (sample_type) (1.0 / steps);; + susp->susp.fetch = quantize_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->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 = quantize_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = quantize_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = quantize_mark; + susp->susp.print_tree = quantize_print_tree; + susp->susp.name = "quantize"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_quantize(sound_type s1, long steps) +{ + sound_type s1_copy = sound_copy(s1); + return snd_make_quantize(s1_copy, steps); +} diff --git a/tran/quantize.h b/tran/quantize.h new file mode 100644 index 0000000..49630da --- /dev/null +++ b/tran/quantize.h @@ -0,0 +1,3 @@ +sound_type snd_make_quantize(sound_type s1, long steps); +sound_type snd_quantize(sound_type s1, long steps); + /* LISP: (snd-quantize SOUND FIXNUM) */ diff --git a/tran/recip.alg b/tran/recip.alg new file mode 100644 index 0000000..8a535d6 --- /dev/null +++ b/tran/recip.alg @@ -0,0 +1,11 @@ +(RECIP-ALG + (NAME "recip") + (ARGUMENTS ("sound_type" "s1")) + (STATE ("double" "scale" "(1.0 / s1->scale)")) + (INTERNAL-SCALING s1) + (CONSTANT "scale") + (START (MIN s1)) + (INNER-LOOP "output = (sample_type) (scale / s1)") + (TERMINATE (MIN s1)) + (LOGICAL-STOP (MIN s1)) +) diff --git a/tran/recip.c b/tran/recip.c new file mode 100644 index 0000000..36dd832 --- /dev/null +++ b/tran/recip.c @@ -0,0 +1,202 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "recip.h" + +void recip_free(); + + +typedef struct recip_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + + double scale; +} recip_susp_node, *recip_susp_type; + + +void recip_n_fetch(register recip_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 double scale_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "recip_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + scale_reg = susp->scale; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) (scale_reg / *s1_ptr_reg++); + } while (--n); /* inner loop */ + + /* using s1_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 */ + + /* 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; + } +} /* recip_n_fetch */ + + +void recip_toss_fetch(susp, snd_list) + register recip_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void recip_mark(recip_susp_type susp) +{ + sound_xlmark(susp->s1); +} + + +void recip_free(recip_susp_type susp) +{ + sound_unref(susp->s1); + ffree_generic(susp, sizeof(recip_susp_node), "recip_free"); +} + + +void recip_print_tree(recip_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); +} + + +sound_type snd_make_recip(sound_type s1) +{ + register recip_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = s1->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, recip_susp_node, "snd_make_recip"); + susp->scale = 1.0 / s1->scale; + susp->susp.fetch = recip_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->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 = recip_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = recip_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = recip_mark; + susp->susp.print_tree = recip_print_tree; + susp->susp.name = "recip"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_recip(sound_type s1) +{ + sound_type s1_copy = sound_copy(s1); + return snd_make_recip(s1_copy); +} diff --git a/tran/recip.h b/tran/recip.h new file mode 100644 index 0000000..059c7c7 --- /dev/null +++ b/tran/recip.h @@ -0,0 +1,3 @@ +sound_type snd_make_recip(sound_type s1); +sound_type snd_recip(sound_type s1); + /* LISP: (snd-recip SOUND) */ diff --git a/tran/reson.alg b/tran/reson.alg new file mode 100644 index 0000000..bc73cc3 --- /dev/null +++ b/tran/reson.alg @@ -0,0 +1,23 @@ +(RESON-ALG +(NAME "reson") +(ARGUMENTS ("sound_type" "s") ("double" "hz") ("double" "bw") + ("int" "normalization")) +(START (MIN s)) +(TERMINATE (MIN s)) +(LOGICAL-STOP (MIN s)) +(STATE ("double" "c3" "exp(bw * -PI2 / s->sr)") + ("double" "c3p1" "susp->c3 + 1.0") + ("double" "c3t4" "susp->c3 * 4.0") + ("double" "omc3" "1.0 - susp->c3") + ("double" "c2" "susp->c3t4 * cos(hz * PI2 / s->sr) / susp->c3p1") + ("double" "c1" "(normalization == 0 ? 1.0 : + (normalization == 1 ? susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1))") + ("double" "y1" "0.0") + ("double" "y2" "0.0")) +(CONSTANT "c1" "c2" "c3") +(INNER-LOOP "{ double y0 = c1 * s + c2 * y1 - c3 * y2; + output = (sample_type) y0; + y2 = y1; y1 = y0; }") +) + diff --git a/tran/reson.c b/tran/reson.c new file mode 100644 index 0000000..c20aa3b --- /dev/null +++ b/tran/reson.c @@ -0,0 +1,339 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "reson.h" + +void reson_free(); + + +typedef struct reson_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 c3; + double c3p1; + double c3t4; + double omc3; + double c2; + double c1; + double y1; + double y2; +} reson_susp_node, *reson_susp_type; + + +void reson_n_fetch(register reson_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 double c3_reg; + register double c2_reg; + register double c1_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "reson_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); + /* 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; + c3_reg = susp->c3; + c2_reg = susp->c2; + c1_reg = susp->c1; + y1_reg = susp->y1; + y2_reg = susp->y2; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ double y0 = c1_reg * *s_ptr_reg++ + c2_reg * y1_reg - c3_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* 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; + } +} /* reson_n_fetch */ + + +void reson_s_fetch(register reson_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 double c3_reg; + register double c2_reg; + register double c1_reg; + register double y1_reg; + register double y2_reg; + register sample_type s_scale_reg = susp->s->scale; + register sample_block_values_type s_ptr_reg; + falloc_sample_block(out, "reson_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 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); + /* 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; + c3_reg = susp->c3; + c2_reg = susp->c2; + c1_reg = susp->c1; + y1_reg = susp->y1; + y2_reg = susp->y2; + s_ptr_reg = susp->s_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ double y0 = c1_reg * (s_scale_reg * *s_ptr_reg++) + c2_reg * y1_reg - c3_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* 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; + } +} /* reson_s_fetch */ + + +void reson_toss_fetch(susp, snd_list) + register reson_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s up to final_time for this block of zeros */ + while ((round((final_time - susp->s->t0) * susp->s->sr)) >= + 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 */ + 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; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void reson_mark(reson_susp_type susp) +{ + sound_xlmark(susp->s); +} + + +void reson_free(reson_susp_type susp) +{ + sound_unref(susp->s); + ffree_generic(susp, sizeof(reson_susp_node), "reson_free"); +} + + +void reson_print_tree(reson_susp_type susp, int n) +{ + indent(n); + stdputstr("s:"); + sound_print_tree_1(susp->s, n); +} + + +sound_type snd_make_reson(sound_type s, double hz, double bw, int normalization) +{ + register reson_susp_type susp; + rate_type sr = s->sr; + time_type t0 = s->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, reson_susp_node, "snd_make_reson"); + susp->c3 = exp(bw * -PI2 / s->sr); + susp->c3p1 = susp->c3 + 1.0; + susp->c3t4 = susp->c3 * 4.0; + susp->omc3 = 1.0 - susp->c3; + susp->c2 = susp->c3t4 * cos(hz * PI2 / s->sr) / susp->c3p1; + susp->c1 = (normalization == 0 ? 1.0 : + (normalization == 1 ? susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)); + susp->y1 = 0.0; + susp->y2 = 0.0; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = reson_n_fetch; break; + case INTERP_s: susp->susp.fetch = reson_s_fetch; break; + default: snd_badsr(); break; + } + + 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 = (long) ((t0 - t0_min) * sr + 0.5); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = reson_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = reson_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = reson_mark; + susp->susp.print_tree = reson_print_tree; + susp->susp.name = "reson"; + 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; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_reson(sound_type s, double hz, double bw, int normalization) +{ + sound_type s_copy = sound_copy(s); + return snd_make_reson(s_copy, hz, bw, normalization); +} diff --git a/tran/reson.h b/tran/reson.h new file mode 100644 index 0000000..aec354a --- /dev/null +++ b/tran/reson.h @@ -0,0 +1,3 @@ +sound_type snd_make_reson(sound_type s, double hz, double bw, int normalization); +sound_type snd_reson(sound_type s, double hz, double bw, int normalization); + /* LISP: (snd-reson SOUND ANYNUM ANYNUM FIXNUM) */ diff --git a/tran/resoncv.alg b/tran/resoncv.alg new file mode 100644 index 0000000..8ad5c64 --- /dev/null +++ b/tran/resoncv.alg @@ -0,0 +1,35 @@ +(RESONCV-ALG +(NAME "resoncv") +(ARGUMENTS ("sound_type" "s1") ("double" "hz") ("sound_type" "bw") + ("int" "normalization")) +(INLINE-INTERPOLATION T) +(INTERNAL-SCALING s1) +(ALWAYS-SCALE bw) +(START (MAX s1 bw)) +(TERMINATE (MIN s1 bw)) +(LOGICAL-STOP (MIN s1)) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION bw) +(STATE ("double" "scale1" "s1->scale") + ("double" "c3co" "0.0") + ("double" "coshz" "cos(hz * PI2 / s1->sr)") + ("double" "c2" "0.0") + ("double" "c1" "0.0") + ("int" "normalization" "normalization") + ("double" "y1" "0.0") + ("double" "y2" "0.0; + bw->scale = (sample_type) (bw->scale * (-PI2 / s1->sr))")) +(DEPENDS ("c3co" "bw" "exp(bw)") + ("c3p1" "bw" "c3co + 1.0" TEMP "double") + ("c3t4" "bw" "c3co * 4.0" TEMP "double") + ("omc3" "bw" "1.0 - c3co" TEMP "double") + ("c2" "bw" "c3t4 * coshz / c3p1") + ("c1" "bw" "(normalization == 0 ? 1.0 : + (normalization == 1 ? omc3 * sqrt(1.0 - c2 * c2 / c3t4) : + sqrt(c3p1 * c3p1 - c2 * c2) * omc3 / c3p1)) * scale1")) +(CONSTANT "c1" "c2" "c3co" "coshz" "normalization" "scale1") +(FORCE-INTO-REGISTER normalization coshz scale1) +(INNER-LOOP "{ double y0 = c1 * s1 + c2 * y1 - c3co * y2; + output = (sample_type) y0; + y2 = y1; y1 = y0; }") +) diff --git a/tran/resoncv.c b/tran/resoncv.c new file mode 100644 index 0000000..77a8eb4 --- /dev/null +++ b/tran/resoncv.c @@ -0,0 +1,600 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "resoncv.h" + +void resoncv_free(); + + +typedef struct resoncv_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type bw; + long bw_cnt; + sample_block_values_type bw_ptr; + + /* support for interpolation of bw */ + sample_type bw_x1_sample; + double bw_pHaSe; + double bw_pHaSe_iNcR; + + /* support for ramp between samples of bw */ + double output_per_bw; + long bw_n; + + double scale1; + double c3co; + double coshz; + double c2; + double c1; + int normalization; + double y1; + double y2; +} resoncv_susp_node, *resoncv_susp_type; + + +void resoncv_ns_fetch(register resoncv_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 double scale1_reg; + register double c3co_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resoncv_ns_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double c3p1; + double c3t4; + double omc3; + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1 = c3co_reg + 1.0; + c3t4 = c3co_reg * 4.0; + omc3 = 1.0 - c3co_reg; + c2_reg = c3t4 * coshz_reg / c3p1; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3 * sqrt(1.0 - c2_reg * c2_reg / c3t4) : + sqrt(c3p1 * c3p1 - c2_reg * c2_reg) * omc3 / c3p1)) * scale1_reg; +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(bw_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; + } +} /* resoncv_ns_fetch */ + + +void resoncv_ni_fetch(register resoncv_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 double scale1_reg; + register double c3co_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resoncv_ni_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + double c3p1; + double c3t4; + double omc3; + susp->started = true; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + c3p1 = susp->c3co + 1.0; + c3t4 = susp->c3co * 4.0; + omc3 = 1.0 - susp->c3co; + susp->c2 = c3t4 * susp->coshz / c3p1; + susp->c1 = (susp->normalization == 0 ? 1.0 : + (susp->normalization == 1 ? omc3 * sqrt(1.0 - susp->c2 * susp->c2 / c3t4) : + sqrt(c3p1 * c3p1 - susp->c2 * susp->c2) * omc3 / c3p1)) * susp->scale1; + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + double c3p1; + double c3t4; + double omc3; + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1 = c3co_reg + 1.0; + c3t4 = c3co_reg * 4.0; + omc3 = 1.0 - c3co_reg; + c2_reg = susp->c2 = c3t4 * coshz_reg / c3p1; + c1_reg = susp->c1 = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3 * sqrt(1.0 - c2_reg * c2_reg / c3t4) : + sqrt(c3p1 * c3p1 - c2_reg * c2_reg) * omc3 / c3p1)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* resoncv_ni_fetch */ + + +void resoncv_nr_fetch(register resoncv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resoncv_nr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + double c3p1; + double c3t4; + double omc3; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + c3p1 = susp->c3co + 1.0; + c3t4 = susp->c3co * 4.0; + omc3 = 1.0 - susp->c3co; + susp->c2 = c3t4 * susp->coshz / c3p1; + susp->c1 = (susp->normalization == 0 ? 1.0 : + (susp->normalization == 1 ? omc3 * sqrt(1.0 - susp->c2 * susp->c2 / c3t4) : + sqrt(c3p1 * c3p1 - susp->c2 * susp->c2) * omc3 / c3p1)) * susp->scale1; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* resoncv_nr_fetch */ + + +void resoncv_toss_fetch(susp, snd_list) + register resoncv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from bw up to final_time for this block of zeros */ + while ((round((final_time - susp->bw->t0) * susp->bw->sr)) >= + susp->bw->current) + susp_get_samples(bw, bw_ptr, bw_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->bw->t0) * susp->bw->sr - + (susp->bw->current - susp->bw_cnt)); + susp->bw_ptr += n; + susp_took(bw_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void resoncv_mark(resoncv_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->bw); +} + + +void resoncv_free(resoncv_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->bw); + ffree_generic(susp, sizeof(resoncv_susp_node), "resoncv_free"); +} + + +void resoncv_print_tree(resoncv_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("bw:"); + sound_print_tree_1(susp->bw, n); +} + + +sound_type snd_make_resoncv(sound_type s1, double hz, sound_type bw, int normalization) +{ + register resoncv_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, bw->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, resoncv_susp_node, "snd_make_resoncv"); + susp->scale1 = s1->scale; + susp->c3co = 0.0; + susp->coshz = cos(hz * PI2 / s1->sr); + susp->c2 = 0.0; + susp->c1 = 0.0; + susp->normalization = normalization; + susp->y1 = 0.0; + susp->y2 = 0.0; + bw->scale = (sample_type) (bw->scale * (-PI2 / s1->sr)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(bw, sr); + switch (interp_desc) { + case INTERP_sn: /* handled below */ + case INTERP_ss: /* handled below */ + case INTERP_nn: /* handled below */ + case INTERP_ns: susp->susp.fetch = resoncv_ns_fetch; break; + case INTERP_si: /* handled below */ + case INTERP_ni: susp->susp.fetch = resoncv_ni_fetch; break; + case INTERP_sr: /* handled below */ + case INTERP_nr: susp->susp.fetch = resoncv_nr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < bw->t0) sound_prepend_zeros(bw, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(bw->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 = resoncv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = resoncv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = resoncv_mark; + susp->susp.print_tree = resoncv_print_tree; + susp->susp.name = "resoncv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->bw = bw; + susp->bw_cnt = 0; + susp->bw_pHaSe = 0.0; + susp->bw_pHaSe_iNcR = bw->sr / sr; + susp->bw_n = 0; + susp->output_per_bw = sr / bw->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_resoncv(sound_type s1, double hz, sound_type bw, int normalization) +{ + sound_type s1_copy = sound_copy(s1); + sound_type bw_copy = sound_copy(bw); + return snd_make_resoncv(s1_copy, hz, bw_copy, normalization); +} diff --git a/tran/resoncv.h b/tran/resoncv.h new file mode 100644 index 0000000..57bbf60 --- /dev/null +++ b/tran/resoncv.h @@ -0,0 +1,3 @@ +sound_type snd_make_resoncv(sound_type s1, double hz, sound_type bw, int normalization); +sound_type snd_resoncv(sound_type s1, double hz, sound_type bw, int normalization); + /* LISP: (snd-resoncv SOUND ANYNUM SOUND FIXNUM) */ diff --git a/tran/resonvc.alg b/tran/resonvc.alg new file mode 100644 index 0000000..74945b8 --- /dev/null +++ b/tran/resonvc.alg @@ -0,0 +1,33 @@ +(RESONVC-ALG +(NAME "resonvc") +(ARGUMENTS ("sound_type" "s1") ("sound_type" "hz") ("double" "bw") + ("int" "normalization")) +(INLINE-INTERPOLATION T) +(INTERNAL-SCALING s1) +(ALWAYS-SCALE hz) +(START (MAX s1 hz)) +(TERMINATE (MIN s1 hz)) +(LOGICAL-STOP (MIN s1)) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION hz) +(STATE ("double" "scale1" "s1->scale") + ("double" "c3co" "exp(bw * -PI2 / s1->sr)") + ("double" "c3p1" "susp->c3co + 1.0") + ("double" "c3t4" "susp->c3co * 4.0") + ("double" "omc3" "1.0 - susp->c3co") + ("double" "c2" "0.0") + ("double" "c1" "0.0") + ("int" "normalization" "normalization") + ("double" "y1" "0.0") + ("double" "y2" "0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr))")) +(DEPENDS ("c2" "hz" "c3t4 * cos(hz) / c3p1") + ("c1" "hz" "(normalization == 0 ? scale1 : + (normalization == 1 ? omc3 * sqrt(1.0 - c2 * c2 / c3t4) : + sqrt(c3p1 * c3p1 - c2 * c2) * omc3 / c3p1)) * scale1")) +(CONSTANT "c1" "c2" "c3co" "c3p1" "c3t4" "omc3" "normalization" "scale1") +(FORCE-INTO-REGISTER c3t4 c3p1 normalization omc3 scale1) +(INNER-LOOP "{ double y0 = c1 * s1 + c2 * y1 - c3co * y2; + output = (sample_type) y0; + y2 = y1; y1 = y0; }") +) diff --git a/tran/resonvc.c b/tran/resonvc.c new file mode 100644 index 0000000..a84e5a5 --- /dev/null +++ b/tran/resonvc.c @@ -0,0 +1,588 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "resonvc.h" + +void resonvc_free(); + + +typedef struct resonvc_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type hz; + long hz_cnt; + sample_block_values_type hz_ptr; + + /* support for interpolation of hz */ + sample_type hz_x1_sample; + double hz_pHaSe; + double hz_pHaSe_iNcR; + + /* support for ramp between samples of hz */ + double output_per_hz; + long hz_n; + + double scale1; + double c3co; + double c3p1; + double c3t4; + double omc3; + double c2; + double c1; + int normalization; + double y1; + double y2; +} resonvc_susp_node, *resonvc_susp_type; + + +void resonvc_ns_fetch(register resonvc_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type hz_scale_reg = susp->hz->scale; + register sample_block_values_type hz_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvc_ns_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz input sample block: */ + susp_check_term_samples(hz, hz_ptr, hz_cnt); + togo = min(togo, susp->hz_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz_ptr_reg = susp->hz_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + c2_reg = c3t4_reg * cos((hz_scale_reg * *hz_ptr_reg++)) / c3p1_reg; + c1_reg = (normalization_reg == 0 ? scale1_reg : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using hz_ptr_reg is a bad idea on RS/6000: */ + susp->hz_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz_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; + } +} /* resonvc_ns_fetch */ + + +void resonvc_ni_fetch(register resonvc_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double hz_pHaSe_iNcR_rEg = susp->hz_pHaSe_iNcR; + register double hz_pHaSe_ReG; + register sample_type hz_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvc_ni_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_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->c2 = susp->c3t4 * cos(susp->hz_x1_sample) / susp->c3p1; + susp->c1 = (susp->normalization == 0 ? susp->scale1 : + (susp->normalization == 1 ? susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)) * susp->scale1; + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz_pHaSe_ReG = susp->hz_pHaSe; + hz_x1_sample_reg = susp->hz_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz_pHaSe_ReG >= 1.0) { +/* fixup-depends hz */ + /* pick up next sample as hz_x1_sample: */ + susp->hz_ptr++; + susp_took(hz_cnt, 1); + hz_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz, hz_ptr, hz_cnt, hz_x1_sample_reg); + hz_x1_sample_reg = susp_current_sample(hz, hz_ptr); + c2_reg = susp->c2 = c3t4_reg * cos(hz_x1_sample_reg) / c3p1_reg; + c1_reg = susp->c1 = (normalization_reg == 0 ? scale1_reg : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + hz_pHaSe_ReG += hz_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->hz_pHaSe = hz_pHaSe_ReG; + susp->hz_x1_sample = hz_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* resonvc_ni_fetch */ + + +void resonvc_nr_fetch(register resonvc_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double c2_reg; + register double c1_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvc_nr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz_pHaSe = 1.0; + } + + susp_check_term_samples(hz, hz_ptr, hz_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz_x1_sample when phase goes past 1.0; */ + /* use hz_n (computed below) to avoid roundoff errors: */ + if (susp->hz_n <= 0) { + susp_check_term_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->hz_pHaSe -= 1.0; + /* hz_n gets number of samples before phase exceeds 1.0: */ + susp->hz_n = (long) ((1.0 - susp->hz_pHaSe) * + susp->output_per_hz); + susp->c2 = susp->c3t4 * cos(susp->hz_x1_sample) / susp->c3p1; + susp->c1 = (susp->normalization == 0 ? susp->scale1 : + (susp->normalization == 1 ? susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)) * susp->scale1; + } + togo = min(togo, susp->hz_n); + hz_val = susp->hz_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + c2_reg = susp->c2; + c1_reg = susp->c1; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz_pHaSe += togo * susp->hz_pHaSe_iNcR; + susp->hz_n -= 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; + } +} /* resonvc_nr_fetch */ + + +void resonvc_toss_fetch(susp, snd_list) + register resonvc_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from hz up to final_time for this block of zeros */ + while ((round((final_time - susp->hz->t0) * susp->hz->sr)) >= + susp->hz->current) + susp_get_samples(hz, hz_ptr, hz_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->hz->t0) * susp->hz->sr - + (susp->hz->current - susp->hz_cnt)); + susp->hz_ptr += n; + susp_took(hz_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void resonvc_mark(resonvc_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->hz); +} + + +void resonvc_free(resonvc_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->hz); + ffree_generic(susp, sizeof(resonvc_susp_node), "resonvc_free"); +} + + +void resonvc_print_tree(resonvc_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("hz:"); + sound_print_tree_1(susp->hz, n); +} + + +sound_type snd_make_resonvc(sound_type s1, sound_type hz, double bw, int normalization) +{ + register resonvc_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, hz->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, resonvc_susp_node, "snd_make_resonvc"); + susp->scale1 = s1->scale; + susp->c3co = exp(bw * -PI2 / s1->sr); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->c2 = 0.0; + susp->c1 = 0.0; + susp->normalization = normalization; + susp->y1 = 0.0; + susp->y2 = 0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(hz, sr); + switch (interp_desc) { + case INTERP_sn: /* handled below */ + case INTERP_ss: /* handled below */ + case INTERP_nn: /* handled below */ + case INTERP_ns: susp->susp.fetch = resonvc_ns_fetch; break; + case INTERP_si: /* handled below */ + case INTERP_ni: susp->susp.fetch = resonvc_ni_fetch; break; + case INTERP_sr: /* handled below */ + case INTERP_nr: susp->susp.fetch = resonvc_nr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < hz->t0) sound_prepend_zeros(hz, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(hz->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 = resonvc_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = resonvc_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = resonvc_mark; + susp->susp.print_tree = resonvc_print_tree; + susp->susp.name = "resonvc"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->hz = hz; + susp->hz_cnt = 0; + susp->hz_pHaSe = 0.0; + susp->hz_pHaSe_iNcR = hz->sr / sr; + susp->hz_n = 0; + susp->output_per_hz = sr / hz->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_resonvc(sound_type s1, sound_type hz, double bw, int normalization) +{ + sound_type s1_copy = sound_copy(s1); + sound_type hz_copy = sound_copy(hz); + return snd_make_resonvc(s1_copy, hz_copy, bw, normalization); +} diff --git a/tran/resonvc.h b/tran/resonvc.h new file mode 100644 index 0000000..b7b5d84 --- /dev/null +++ b/tran/resonvc.h @@ -0,0 +1,3 @@ +sound_type snd_make_resonvc(sound_type s1, sound_type hz, double bw, int normalization); +sound_type snd_resonvc(sound_type s1, sound_type hz, double bw, int normalization); + /* LISP: (snd-resonvc SOUND SOUND ANYNUM FIXNUM) */ diff --git a/tran/resonvv.alg b/tran/resonvv.alg new file mode 100644 index 0000000..4f6f429 --- /dev/null +++ b/tran/resonvv.alg @@ -0,0 +1,47 @@ +(RESONVV-ALG +(NAME "resonvv") +(ARGUMENTS ("sound_type" "s1") ("sound_type" "hz1") ("sound_type" "bw") + ("int" "normalization")) +(INLINE-INTERPOLATION T) +(ALWAYS-SCALE hz1 bw) +(START (MAX s1 hz1 bw)) +(TERMINATE (MIN s1 hz1 bw)) +(LOGICAL-STOP (MIN s1)) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION hz1 bw) +(STATE ("double" "scale1" "s1->scale") + ("double" "c3co" "0.0") + ("double" "c3p1" "0.0") + ("double" "c3t4" "0.0") + ("double" "omc3" "0.0") + ("double" "coshz" "0.0") + ("double" "c2" "0.0") + ("double" "c1" "0.0") + ("boolean" "recompute" "false") + ("int" "normalization" "normalization") + ("double" "y1" "0.0") + ("double" "y2" "0.0; + hz1->scale = (sample_type) (hz1->scale * (PI2 / s1->sr)); + bw->scale = (sample_type) (bw->scale * (-PI2 / s1->sr));")) +(DEPENDS ("c3co" "bw" "exp(bw)") + ("c3p1" "bw" "c3co + 1.0") + ("c3t4" "bw" "c3co * 4.0") + ("omc3" "bw" "1.0 - c3co") + ("recompute" "bw" "true") + ("coshz" "hz1" "cos(hz1)") + ("recompute" "hz1" "true")) +(JOINT-DEPENDENCY (("hz1" "bw") +"if (recompute) {" +" recompute = false;" +" c2 = c3t4 * coshz / c3p1;" +" c1 = (normalization == 0 ? 1.0 :" +" (normalization == 1 ? omc3 * sqrt(1.0 - c2 * c2 / c3t4) :" +" sqrt(c3p1 * c3p1 - c2 * c2) * omc3 / c3p1)) * scale1;" +"}")) +(CONSTANT "c1" "c2" "c3co" "coshz" "c3p1" "c3t4" "omc3" + "normalization" "scale1") +(FORCE-INTO-REGISTER recompute) ;c3t4 c3p1 normalization omc3 scale1 +(INNER-LOOP "{ double y0 = c1 * s1 + c2 * y1 - c3co * y2; + output = (sample_type) y0; + y2 = y1; y1 = y0; }") +) diff --git a/tran/resonvv.c b/tran/resonvv.c new file mode 100644 index 0000000..3b2aca9 --- /dev/null +++ b/tran/resonvv.c @@ -0,0 +1,3251 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "resonvv.h" + +void resonvv_free(); + + +typedef struct resonvv_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type hz1; + long hz1_cnt; + sample_block_values_type hz1_ptr; + + /* support for interpolation of hz1 */ + sample_type hz1_x1_sample; + double hz1_pHaSe; + double hz1_pHaSe_iNcR; + + /* support for ramp between samples of hz1 */ + double output_per_hz1; + long hz1_n; + sound_type bw; + long bw_cnt; + sample_block_values_type bw_ptr; + + /* support for interpolation of bw */ + sample_type bw_x1_sample; + double bw_pHaSe; + double bw_pHaSe_iNcR; + + /* support for ramp between samples of bw */ + double output_per_bw; + long bw_n; + + double scale1; + double c3co; + double c3p1; + double c3t4; + double omc3; + double coshz; + double c2; + double c1; + boolean recompute; + int normalization; + double y1; + double y2; +} resonvv_susp_node, *resonvv_susp_type; + + +void resonvv_nss_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nss_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_cnt, togo); + susp_took(bw_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; + } +} /* resonvv_nss_fetch */ + + +void resonvv_nsi_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nsi_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_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_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; + } +} /* resonvv_nsi_fetch */ + + +void resonvv_nsr_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nsr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* resonvv_nsr_fetch */ + + +void resonvv_nis_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nis_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(bw_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; + } +} /* resonvv_nis_fetch */ + + +void resonvv_nii_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nii_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* resonvv_nii_fetch */ + + +void resonvv_nir_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nir_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* resonvv_nir_fetch */ + + +void resonvv_nrs_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nrs_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= togo; + susp_took(bw_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; + } +} /* resonvv_nrs_fetch */ + + +void resonvv_nri_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nri_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= 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; + } +} /* resonvv_nri_fetch */ + + +void resonvv_nrr_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register double y1_reg; + register double y2_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_nrr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + if (susp->recompute) { + susp->recompute = false; + susp->c2 = susp->c3t4 * susp->coshz / susp->c3p1; + susp->c1 = (susp->normalization == 0 ? 1.0 : + (susp->normalization == 1 ? susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)) * susp->scale1; + } + /* 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; + c3co_reg = susp->c3co; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + y1_reg = susp->y1; + y2_reg = susp->y2; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ double y0 = c1_reg * *s1_ptr_reg++ + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= togo; + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* resonvv_nrr_fetch */ + + +void resonvv_sss_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_sss_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_cnt, togo); + susp_took(bw_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; + } +} /* resonvv_sss_fetch */ + + +void resonvv_ssi_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_ssi_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_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_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; + } +} /* resonvv_ssi_fetch */ + + +void resonvv_ssr_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type hz1_scale_reg = susp->hz1->scale; + register sample_block_values_type hz1_ptr_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_ssr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz1 input sample block: */ + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + togo = min(togo, susp->hz1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz1_ptr_reg = susp->hz1_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + coshz_reg = cos((hz1_scale_reg * *hz1_ptr_reg++)); + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using hz1_ptr_reg is a bad idea on RS/6000: */ + susp->hz1_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* resonvv_ssr_fetch */ + + +void resonvv_sis_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_sis_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(bw_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; + } +} /* resonvv_sis_fetch */ + + +void resonvv_sii_fetch(register resonvv_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 double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_sii_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* resonvv_sii_fetch */ + + +void resonvv_sir_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double hz1_pHaSe_iNcR_rEg = susp->hz1_pHaSe_iNcR; + register double hz1_pHaSe_ReG; + register sample_type hz1_x1_sample_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_sir_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_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + hz1_pHaSe_ReG = susp->hz1_pHaSe; + hz1_x1_sample_reg = susp->hz1_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz1_pHaSe_ReG >= 1.0) { +/* fixup-depends hz1 */ + /* pick up next sample as hz1_x1_sample: */ + susp->hz1_ptr++; + susp_took(hz1_cnt, 1); + hz1_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz1, hz1_ptr, hz1_cnt, hz1_x1_sample_reg); + hz1_x1_sample_reg = susp_current_sample(hz1, hz1_ptr); + coshz_reg = susp->coshz = cos(hz1_x1_sample_reg); + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + hz1_pHaSe_ReG += hz1_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->hz1_pHaSe = hz1_pHaSe_ReG; + susp->hz1_x1_sample = hz1_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* resonvv_sir_fetch */ + + +void resonvv_srs_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register sample_type bw_scale_reg = susp->bw->scale; + register sample_block_values_type bw_ptr_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_srs_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* don't run past the bw input sample block: */ + susp_check_term_samples(bw, bw_ptr, bw_cnt); + togo = min(togo, susp->bw_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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_ptr_reg = susp->bw_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + c3co_reg = exp((bw_scale_reg * *bw_ptr_reg++)); + c3p1_reg = c3co_reg + 1.0; + c3t4_reg = c3co_reg * 4.0; + omc3_reg = 1.0 - c3co_reg; + recompute_reg = true; + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using bw_ptr_reg is a bad idea on RS/6000: */ + susp->bw_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= togo; + susp_took(bw_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; + } +} /* resonvv_srs_fetch */ + + +void resonvv_sri_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c3co_reg; + register double c3p1_reg; + register double c3t4_reg; + register double omc3_reg; + register double coshz_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register int normalization_reg; + register double y1_reg; + register double y2_reg; + register double bw_pHaSe_iNcR_rEg = susp->bw_pHaSe_iNcR; + register double bw_pHaSe_ReG; + register sample_type bw_x1_sample_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_sri_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c3co_reg = susp->c3co; + c3p1_reg = susp->c3p1; + c3t4_reg = susp->c3t4; + omc3_reg = susp->omc3; + coshz_reg = susp->coshz; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + normalization_reg = susp->normalization; + y1_reg = susp->y1; + y2_reg = susp->y2; + bw_pHaSe_ReG = susp->bw_pHaSe; + bw_x1_sample_reg = susp->bw_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (bw_pHaSe_ReG >= 1.0) { +/* fixup-depends bw */ + /* pick up next sample as bw_x1_sample: */ + susp->bw_ptr++; + susp_took(bw_cnt, 1); + bw_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(bw, bw_ptr, bw_cnt, bw_x1_sample_reg); + bw_x1_sample_reg = susp_current_sample(bw, bw_ptr); + c3co_reg = susp->c3co = exp(bw_x1_sample_reg); + c3p1_reg = susp->c3p1 = c3co_reg + 1.0; + c3t4_reg = susp->c3t4 = c3co_reg * 4.0; + omc3_reg = susp->omc3 = 1.0 - c3co_reg; + recompute_reg = susp->recompute = true; + } + if (recompute_reg) { + recompute_reg = false; + c2_reg = c3t4_reg * coshz_reg / c3p1_reg; + c1_reg = (normalization_reg == 0 ? 1.0 : + (normalization_reg == 1 ? omc3_reg * sqrt(1.0 - c2_reg * c2_reg / c3t4_reg) : + sqrt(c3p1_reg * c3p1_reg - c2_reg * c2_reg) * omc3_reg / c3p1_reg)) * scale1_reg; + } +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + bw_pHaSe_ReG += bw_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + susp->bw_pHaSe = bw_pHaSe_ReG; + susp->bw_x1_sample = bw_x1_sample_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= 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; + } +} /* resonvv_sri_fetch */ + + +void resonvv_srr_fetch(register resonvv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz1_val; + sample_type bw_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double c3co_reg; + register double c2_reg; + register double c1_reg; + register boolean recompute_reg; + register double y1_reg; + register double y2_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "resonvv_srr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz1_pHaSe = 1.0; + susp->bw_pHaSe = 1.0; + } + + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + + susp_check_term_samples(bw, bw_ptr, bw_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz1_x1_sample when phase goes past 1.0; */ + /* use hz1_n (computed below) to avoid roundoff errors: */ + if (susp->hz1_n <= 0) { + susp_check_term_samples(hz1, hz1_ptr, hz1_cnt); + susp->hz1_x1_sample = susp_fetch_sample(hz1, hz1_ptr, hz1_cnt); + susp->hz1_pHaSe -= 1.0; + /* hz1_n gets number of samples before phase exceeds 1.0: */ + susp->hz1_n = (long) ((1.0 - susp->hz1_pHaSe) * + susp->output_per_hz1); + susp->coshz = cos(susp->hz1_x1_sample); + susp->recompute = true; + } + togo = min(togo, susp->hz1_n); + hz1_val = susp->hz1_x1_sample; + /* grab next bw_x1_sample when phase goes past 1.0; */ + /* use bw_n (computed below) to avoid roundoff errors: */ + if (susp->bw_n <= 0) { + susp_check_term_samples(bw, bw_ptr, bw_cnt); + susp->bw_x1_sample = susp_fetch_sample(bw, bw_ptr, bw_cnt); + susp->bw_pHaSe -= 1.0; + /* bw_n gets number of samples before phase exceeds 1.0: */ + susp->bw_n = (long) ((1.0 - susp->bw_pHaSe) * + susp->output_per_bw); + susp->c3co = exp(susp->bw_x1_sample); + susp->c3p1 = susp->c3co + 1.0; + susp->c3t4 = susp->c3co * 4.0; + susp->omc3 = 1.0 - susp->c3co; + susp->recompute = true; + } + togo = min(togo, susp->bw_n); + bw_val = susp->bw_x1_sample; + if (susp->recompute) { + susp->recompute = false; + susp->c2 = susp->c3t4 * susp->coshz / susp->c3p1; + susp->c1 = (susp->normalization == 0 ? 1.0 : + (susp->normalization == 1 ? susp->omc3 * sqrt(1.0 - susp->c2 * susp->c2 / susp->c3t4) : + sqrt(susp->c3p1 * susp->c3p1 - susp->c2 * susp->c2) * susp->omc3 / susp->c3p1)) * susp->scale1; + } + /* 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; + c3co_reg = susp->c3co; + c2_reg = susp->c2; + c1_reg = susp->c1; + recompute_reg = susp->recompute; + y1_reg = susp->y1; + y2_reg = susp->y2; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ double y0 = c1_reg * (s1_scale_reg * *s1_ptr_reg++) + c2_reg * y1_reg - c3co_reg * y2_reg; + *out_ptr_reg++ = (sample_type) y0; + y2_reg = y1_reg; y1_reg = y0; }; + } while (--n); /* inner loop */ + + susp->recompute = recompute_reg; + susp->y1 = y1_reg; + susp->y2 = y2_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz1_pHaSe += togo * susp->hz1_pHaSe_iNcR; + susp->hz1_n -= togo; + susp->bw_pHaSe += togo * susp->bw_pHaSe_iNcR; + susp->bw_n -= 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; + } +} /* resonvv_srr_fetch */ + + +void resonvv_toss_fetch(susp, snd_list) + register resonvv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from hz1 up to final_time for this block of zeros */ + while ((round((final_time - susp->hz1->t0) * susp->hz1->sr)) >= + susp->hz1->current) + susp_get_samples(hz1, hz1_ptr, hz1_cnt); + /* fetch samples from bw up to final_time for this block of zeros */ + while ((round((final_time - susp->bw->t0) * susp->bw->sr)) >= + susp->bw->current) + susp_get_samples(bw, bw_ptr, bw_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->hz1->t0) * susp->hz1->sr - + (susp->hz1->current - susp->hz1_cnt)); + susp->hz1_ptr += n; + susp_took(hz1_cnt, n); + n = round((final_time - susp->bw->t0) * susp->bw->sr - + (susp->bw->current - susp->bw_cnt)); + susp->bw_ptr += n; + susp_took(bw_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void resonvv_mark(resonvv_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->hz1); + sound_xlmark(susp->bw); +} + + +void resonvv_free(resonvv_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->hz1); + sound_unref(susp->bw); + ffree_generic(susp, sizeof(resonvv_susp_node), "resonvv_free"); +} + + +void resonvv_print_tree(resonvv_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("hz1:"); + sound_print_tree_1(susp->hz1, n); + + indent(n); + stdputstr("bw:"); + sound_print_tree_1(susp->bw, n); +} + + +sound_type snd_make_resonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization) +{ + register resonvv_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(max(s1->t0, hz1->t0), bw->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, resonvv_susp_node, "snd_make_resonvv"); + susp->scale1 = s1->scale; + susp->c3co = 0.0; + susp->c3p1 = 0.0; + susp->c3t4 = 0.0; + susp->omc3 = 0.0; + susp->coshz = 0.0; + susp->c2 = 0.0; + susp->c1 = 0.0; + susp->recompute = false; + susp->normalization = normalization; + susp->y1 = 0.0; + susp->y2 = 0.0; + hz1->scale = (sample_type) (hz1->scale * (PI2 / s1->sr)); + bw->scale = (sample_type) (bw->scale * (-PI2 / s1->sr));; + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(hz1, sr); + interp_desc = (interp_desc << 2) + interp_style(bw, sr); + switch (interp_desc) { + case INTERP_nnn: /* handled below */ + case INTERP_nns: /* handled below */ + case INTERP_nsn: /* handled below */ + case INTERP_nss: susp->susp.fetch = resonvv_nss_fetch; break; + case INTERP_nni: /* handled below */ + case INTERP_nsi: susp->susp.fetch = resonvv_nsi_fetch; break; + case INTERP_nnr: /* handled below */ + case INTERP_nsr: susp->susp.fetch = resonvv_nsr_fetch; break; + case INTERP_nin: /* handled below */ + case INTERP_nis: susp->susp.fetch = resonvv_nis_fetch; break; + case INTERP_nii: susp->susp.fetch = resonvv_nii_fetch; break; + case INTERP_nir: susp->susp.fetch = resonvv_nir_fetch; break; + case INTERP_nrn: /* handled below */ + case INTERP_nrs: susp->susp.fetch = resonvv_nrs_fetch; break; + case INTERP_nri: susp->susp.fetch = resonvv_nri_fetch; break; + case INTERP_nrr: susp->susp.fetch = resonvv_nrr_fetch; break; + case INTERP_snn: /* handled below */ + case INTERP_sns: /* handled below */ + case INTERP_ssn: /* handled below */ + case INTERP_sss: susp->susp.fetch = resonvv_sss_fetch; break; + case INTERP_sni: /* handled below */ + case INTERP_ssi: susp->susp.fetch = resonvv_ssi_fetch; break; + case INTERP_snr: /* handled below */ + case INTERP_ssr: susp->susp.fetch = resonvv_ssr_fetch; break; + case INTERP_sin: /* handled below */ + case INTERP_sis: susp->susp.fetch = resonvv_sis_fetch; break; + case INTERP_sii: susp->susp.fetch = resonvv_sii_fetch; break; + case INTERP_sir: susp->susp.fetch = resonvv_sir_fetch; break; + case INTERP_srn: /* handled below */ + case INTERP_srs: susp->susp.fetch = resonvv_srs_fetch; break; + case INTERP_sri: susp->susp.fetch = resonvv_sri_fetch; break; + case INTERP_srr: susp->susp.fetch = resonvv_srr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < hz1->t0) sound_prepend_zeros(hz1, t0); + if (t0 < bw->t0) sound_prepend_zeros(bw, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(hz1->t0, min(bw->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 = resonvv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = resonvv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = resonvv_mark; + susp->susp.print_tree = resonvv_print_tree; + susp->susp.name = "resonvv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->hz1 = hz1; + susp->hz1_cnt = 0; + susp->hz1_pHaSe = 0.0; + susp->hz1_pHaSe_iNcR = hz1->sr / sr; + susp->hz1_n = 0; + susp->output_per_hz1 = sr / hz1->sr; + susp->bw = bw; + susp->bw_cnt = 0; + susp->bw_pHaSe = 0.0; + susp->bw_pHaSe_iNcR = bw->sr / sr; + susp->bw_n = 0; + susp->output_per_bw = sr / bw->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_resonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization) +{ + sound_type s1_copy = sound_copy(s1); + sound_type hz1_copy = sound_copy(hz1); + sound_type bw_copy = sound_copy(bw); + return snd_make_resonvv(s1_copy, hz1_copy, bw_copy, normalization); +} diff --git a/tran/resonvv.h b/tran/resonvv.h new file mode 100644 index 0000000..f1fee48 --- /dev/null +++ b/tran/resonvv.h @@ -0,0 +1,3 @@ +sound_type snd_make_resonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization); +sound_type snd_resonvv(sound_type s1, sound_type hz1, sound_type bw, int normalization); + /* LISP: (snd-resonvv SOUND SOUND SOUND FIXNUM) */ diff --git a/tran/sampler.alg b/tran/sampler.alg new file mode 100644 index 0000000..cc5fad7 --- /dev/null +++ b/tran/sampler.alg @@ -0,0 +1,49 @@ +(SAMPLER-ALG +(NAME "sampler") +(ARGUMENTS ("sound_type" "s") ("double" "step") ("double" "loop_start") + ("rate_type" "sr") ("double" "hz") ("time_type" "t0") ("sound_type" "s_fm") + ("long" "npoints")) +(TABLE "s") +(NOT-IN-INNER-LOOP "s") +(STATE + ("double" "loop_to" "loop_start * s->sr") + ("table_type" "the_table" "sound_to_table(s)") + ("sample_type *" "table_ptr" "susp->the_table->samples") + ("double" "table_len" "susp->the_table->length; + { long index = (long) susp->loop_to; + double frac = susp->loop_to - index; + if (index > round(susp->table_len) || + index < 0) { + index = 0; + frac = 0; + } + susp->table_ptr[round(susp->table_len)] = /* copy interpolated start to last entry */ + (sample_type) (susp->table_ptr[index] * (1.0 - frac) + + susp->table_ptr[index + 1] * frac);}") + ("double" "phase" "0.0") + ("double" "ph_incr" "(s->sr / sr) * hz / step_to_hz(step); + s_fm->scale = (sample_type) (s_fm->scale * (susp->ph_incr / hz))") ) + +(ALWAYS-SCALE s_fm) +(INLINE-INTERPOLATION T) ; so that modulation can be low frequency +(STEP-FUNCTION s_fm) +(TERMINATE (MIN s_fm)) +(LOGICAL-STOP (MIN s_fm)) +(INNER-LOOP-LOCALS " long table_index; + double x1; +") +(INNER-LOOP "table_index = (long) phase; + x1 = table_ptr[table_index]; + output = (sample_type) (x1 + (phase - table_index) * + (table_ptr[table_index + 1] - x1)); + phase += ph_incr + s_fm; + while (phase > table_len) phase -= (table_len - loop_to); + /* watch out for negative frequencies! */ + if (phase < 0) phase = 0") +(CONSTANT "ph_incr" "table_len" "table_ptr" "loop_to") + +(SAMPLE-RATE "sr") +(FINALIZATION " table_unref(susp->the_table); +") +) + diff --git a/tran/sampler.c b/tran/sampler.c new file mode 100644 index 0000000..2ba3ed3 --- /dev/null +++ b/tran/sampler.c @@ -0,0 +1,510 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "sampler.h" + +void sampler_free(); + + +typedef struct sampler_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s_fm; + long s_fm_cnt; + sample_block_values_type s_fm_ptr; + + /* support for interpolation of s_fm */ + sample_type s_fm_x1_sample; + double s_fm_pHaSe; + double s_fm_pHaSe_iNcR; + + /* support for ramp between samples of s_fm */ + double output_per_s_fm; + long s_fm_n; + + double loop_to; + table_type the_table; + sample_type *table_ptr; + double table_len; + double phase; + double ph_incr; +} sampler_susp_node, *sampler_susp_type; + + +void sampler_s_fetch(register sampler_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 double loop_to_reg; + register sample_type * table_ptr_reg; + register double table_len_reg; + register double phase_reg; + register double ph_incr_reg; + register sample_type s_fm_scale_reg = susp->s_fm->scale; + register sample_block_values_type s_fm_ptr_reg; + falloc_sample_block(out, "sampler_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 s_fm input sample block: */ + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + togo = min(togo, susp->s_fm_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; + loop_to_reg = susp->loop_to; + table_ptr_reg = susp->table_ptr; + table_len_reg = susp->table_len; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + s_fm_ptr_reg = susp->s_fm_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; +table_index = (long) phase_reg; + x1 = table_ptr_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)); + phase_reg += ph_incr_reg + (s_fm_scale_reg * *s_fm_ptr_reg++); + while (phase_reg > table_len_reg) phase_reg -= (table_len_reg - loop_to_reg); + /* watch out for negative frequencies! */ + if (phase_reg < 0) phase_reg = 0; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + /* using s_fm_ptr_reg is a bad idea on RS/6000: */ + susp->s_fm_ptr += togo; + out_ptr += togo; + susp_took(s_fm_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; + } +} /* sampler_s_fetch */ + + +void sampler_i_fetch(register sampler_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 double loop_to_reg; + register sample_type * table_ptr_reg; + register double table_len_reg; + register double phase_reg; + register double ph_incr_reg; + register double s_fm_pHaSe_iNcR_rEg = susp->s_fm_pHaSe_iNcR; + register double s_fm_pHaSe_ReG; + register sample_type s_fm_x1_sample_reg; + falloc_sample_block(out, "sampler_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_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + } + + 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); + /* 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; + loop_to_reg = susp->loop_to; + table_ptr_reg = susp->table_ptr; + table_len_reg = susp->table_len; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + s_fm_pHaSe_ReG = susp->s_fm_pHaSe; + s_fm_x1_sample_reg = susp->s_fm_x1_sample; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; + if (s_fm_pHaSe_ReG >= 1.0) { +/* fixup-depends s_fm */ + /* pick up next sample as s_fm_x1_sample: */ + susp->s_fm_ptr++; + susp_took(s_fm_cnt, 1); + s_fm_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(s_fm, s_fm_ptr, s_fm_cnt, s_fm_x1_sample_reg); + s_fm_x1_sample_reg = susp_current_sample(s_fm, s_fm_ptr); + } +table_index = (long) phase_reg; + x1 = table_ptr_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)); + phase_reg += ph_incr_reg + s_fm_x1_sample_reg; + while (phase_reg > table_len_reg) phase_reg -= (table_len_reg - loop_to_reg); + /* watch out for negative frequencies! */ + if (phase_reg < 0) phase_reg = 0; + s_fm_pHaSe_ReG += s_fm_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->phase = phase_reg; + susp->s_fm_pHaSe = s_fm_pHaSe_ReG; + susp->s_fm_x1_sample = s_fm_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; + } +} /* sampler_i_fetch */ + + +void sampler_r_fetch(register sampler_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type s_fm_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double loop_to_reg; + register sample_type * table_ptr_reg; + register double table_len_reg; + register double phase_reg; + register double ph_incr_reg; + falloc_sample_block(out, "sampler_r_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->s_fm_pHaSe = 1.0; + } + + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + + 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; + + /* grab next s_fm_x1_sample when phase goes past 1.0; */ + /* use s_fm_n (computed below) to avoid roundoff errors: */ + if (susp->s_fm_n <= 0) { + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_pHaSe -= 1.0; + /* s_fm_n gets number of samples before phase exceeds 1.0: */ + susp->s_fm_n = (long) ((1.0 - susp->s_fm_pHaSe) * + susp->output_per_s_fm); + } + togo = min(togo, susp->s_fm_n); + s_fm_val = susp->s_fm_x1_sample; + /* 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; + loop_to_reg = susp->loop_to; + table_ptr_reg = susp->table_ptr; + table_len_reg = susp->table_len; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double x1; +table_index = (long) phase_reg; + x1 = table_ptr_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (phase_reg - table_index) * + (table_ptr_reg[table_index + 1] - x1)); + phase_reg += ph_incr_reg + s_fm_val; + while (phase_reg > table_len_reg) phase_reg -= (table_len_reg - loop_to_reg); + /* watch out for negative frequencies! */ + if (phase_reg < 0) phase_reg = 0; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + out_ptr += togo; + susp->s_fm_pHaSe += togo * susp->s_fm_pHaSe_iNcR; + susp->s_fm_n -= 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; + } +} /* sampler_r_fetch */ + + +void sampler_toss_fetch(susp, snd_list) + register sampler_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s_fm up to final_time for this block of zeros */ + while ((round((final_time - susp->s_fm->t0) * susp->s_fm->sr)) >= + susp->s_fm->current) + susp_get_samples(s_fm, s_fm_ptr, s_fm_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s_fm->t0) * susp->s_fm->sr - + (susp->s_fm->current - susp->s_fm_cnt)); + susp->s_fm_ptr += n; + susp_took(s_fm_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void sampler_mark(sampler_susp_type susp) +{ + sound_xlmark(susp->s_fm); +} + + +void sampler_free(sampler_susp_type susp) +{ + table_unref(susp->the_table); + sound_unref(susp->s_fm); + ffree_generic(susp, sizeof(sampler_susp_node), "sampler_free"); +} + + +void sampler_print_tree(sampler_susp_type susp, int n) +{ + indent(n); + stdputstr("s_fm:"); + sound_print_tree_1(susp->s_fm, n); +} + + +sound_type snd_make_sampler(sound_type s, double step, double loop_start, rate_type sr, double hz, time_type t0, sound_type s_fm, long npoints) +{ + register sampler_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, sampler_susp_node, "snd_make_sampler"); + susp->loop_to = loop_start * s->sr; + susp->the_table = sound_to_table(s); + susp->table_ptr = susp->the_table->samples; + susp->table_len = susp->the_table->length; + { long index = (long) susp->loop_to; + double frac = susp->loop_to - index; + if (index > round(susp->table_len) || + index < 0) { + index = 0; + frac = 0; + } + susp->table_ptr[round(susp->table_len)] = /* copy interpolated start to last entry */ + (sample_type) (susp->table_ptr[index] * (1.0 - frac) + + susp->table_ptr[index + 1] * frac);}; + susp->phase = 0.0; + susp->ph_incr = (s->sr / sr) * hz / step_to_hz(step); + s_fm->scale = (sample_type) (s_fm->scale * (susp->ph_incr / hz)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s_fm, sr); + switch (interp_desc) { + case INTERP_n: /* handled below */ + case INTERP_s: susp->susp.fetch = sampler_s_fetch; break; + case INTERP_i: susp->susp.fetch = sampler_i_fetch; break; + case INTERP_r: susp->susp.fetch = sampler_r_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s_fm->t0) sound_prepend_zeros(s_fm, t0); + /* minimum start time over all inputs: */ + t0_min = min(s_fm->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 = sampler_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = sampler_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = sampler_mark; + susp->susp.print_tree = sampler_print_tree; + susp->susp.name = "sampler"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s_fm); + susp->started = false; + susp->susp.current = 0; + susp->s_fm = s_fm; + susp->s_fm_cnt = 0; + susp->s_fm_pHaSe = 0.0; + susp->s_fm_pHaSe_iNcR = s_fm->sr / sr; + susp->s_fm_n = 0; + susp->output_per_s_fm = sr / s_fm->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_sampler(sound_type s, double step, double loop_start, rate_type sr, double hz, time_type t0, sound_type s_fm, long npoints) +{ + sound_type s_fm_copy = sound_copy(s_fm); + return snd_make_sampler(s, step, loop_start, sr, hz, t0, s_fm_copy, npoints); +} diff --git a/tran/sampler.h b/tran/sampler.h new file mode 100644 index 0000000..49be41e --- /dev/null +++ b/tran/sampler.h @@ -0,0 +1,3 @@ +sound_type snd_make_sampler(sound_type s, double step, double loop_start, rate_type sr, double hz, time_type t0, sound_type s_fm, long npoints); +sound_type snd_sampler(sound_type s, double step, double loop_start, rate_type sr, double hz, time_type t0, sound_type s_fm, long npoints); + /* LISP: (snd-sampler SOUND ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM SOUND FIXNUM) */ diff --git a/tran/scale.alg b/tran/scale.alg new file mode 100644 index 0000000..f993e95 --- /dev/null +++ b/tran/scale.alg @@ -0,0 +1,11 @@ +(SCALE-ALG + (NAME "normalize") + (ARGUMENTS ("sound_type" "s1")) + (STATE ("sample_type" "scale" "s1->scale")) + (CONSTANT "scale") + (START (MIN s1)) + (INTERNAL-SCALING s1) + (INNER-LOOP "output = s1 * scale") + (TERMINATE (MIN s1)) + (LOGICAL-STOP (MIN s1)) +) diff --git a/tran/scale.c b/tran/scale.c new file mode 100644 index 0000000..cc011a9 --- /dev/null +++ b/tran/scale.c @@ -0,0 +1,202 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "scale.h" + +void normalize_free(); + + +typedef struct normalize_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + + sample_type scale; +} normalize_susp_node, *normalize_susp_type; + + +void normalize_n_fetch(register normalize_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 scale_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "normalize_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + scale_reg = susp->scale; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = *s1_ptr_reg++ * scale_reg; + } while (--n); /* inner loop */ + + /* using s1_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 */ + + /* 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; + } +} /* normalize_n_fetch */ + + +void normalize_toss_fetch(susp, snd_list) + register normalize_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void normalize_mark(normalize_susp_type susp) +{ + sound_xlmark(susp->s1); +} + + +void normalize_free(normalize_susp_type susp) +{ + sound_unref(susp->s1); + ffree_generic(susp, sizeof(normalize_susp_node), "normalize_free"); +} + + +void normalize_print_tree(normalize_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); +} + + +sound_type snd_make_normalize(sound_type s1) +{ + register normalize_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = s1->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, normalize_susp_node, "snd_make_normalize"); + susp->scale = s1->scale; + susp->susp.fetch = normalize_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->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 = normalize_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = normalize_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = normalize_mark; + susp->susp.print_tree = normalize_print_tree; + susp->susp.name = "normalize"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_normalize(sound_type s1) +{ + sound_type s1_copy = sound_copy(s1); + return snd_make_normalize(s1_copy); +} diff --git a/tran/scale.h b/tran/scale.h new file mode 100644 index 0000000..48f73f9 --- /dev/null +++ b/tran/scale.h @@ -0,0 +1,3 @@ +sound_type snd_make_normalize(sound_type s1); +sound_type snd_normalize(sound_type s1); + /* LISP: (snd-normalize SOUND) */ diff --git a/tran/shape.alg b/tran/shape.alg new file mode 100644 index 0000000..ad6d603 --- /dev/null +++ b/tran/shape.alg @@ -0,0 +1,39 @@ +(SHAPE-ALG + (NAME "shape") + (ARGUMENTS ("sound_type" "sin") ("sound_type" "fn") + ("double" "origin")) + (START (MIN sin)) + (TABLE "fn") + (NOT-IN-INNER-LOOP "fn") + (STATE + ("double" "time_to_index" "fn->sr") + ("double" "origin" "origin") + ("table_type" "the_table" "sound_to_table(fn)") + ("sample_type *" "fcn_table" "susp->the_table->samples") + ("double" "table_len" "susp->the_table->length") ) + (TERMINATE (MIN sin)) + (LOGICAL-STOP (MIN sin)) + (INNER-LOOP " + register double offset, x1; + register long table_index; + register double phase = sin; + if (phase > 1.0) phase = 1.0; + else if (phase < -1.0) phase = -1.0; + offset = (phase + origin) * time_to_index; + table_index = (long) offset; + if (table_index < 0) { + table_index = 0; + offset = 0; + } + if (table_index >= table_len) { + offset = table_len - 1; + table_index = (long) offset; + } + x1 = fcn_table[table_index]; + output = (sample_type) (x1 + (offset - table_index) * + (fcn_table[table_index + 1] - x1)); + ") + (ALWAYS-SCALE sin) + (CONSTANT "table_len" "time_to_index" "origen" "fcn_table" "the_table") + (FINALIZATION "table_unref(susp->the_table);") +) diff --git a/tran/shape.c b/tran/shape.c new file mode 100644 index 0000000..1df83c4 --- /dev/null +++ b/tran/shape.c @@ -0,0 +1,237 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "shape.h" + +void shape_free(); + + +typedef struct shape_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type sin; + long sin_cnt; + sample_block_values_type sin_ptr; + + double time_to_index; + double origin; + table_type the_table; + sample_type *fcn_table; + double table_len; +} shape_susp_node, *shape_susp_type; + + +void shape_s_fetch(register shape_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 double time_to_index_reg; + register double origin_reg; + register sample_type * fcn_table_reg; + register double table_len_reg; + register sample_type sin_scale_reg = susp->sin->scale; + register sample_block_values_type sin_ptr_reg; + falloc_sample_block(out, "shape_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 sin input sample block: */ + susp_check_term_log_samples(sin, sin_ptr, sin_cnt); + togo = min(togo, susp->sin_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; + time_to_index_reg = susp->time_to_index; + origin_reg = susp->origin; + fcn_table_reg = susp->fcn_table; + table_len_reg = susp->table_len; + sin_ptr_reg = susp->sin_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + register double offset, x1; + register long table_index; + register double phase = (sin_scale_reg * *sin_ptr_reg++); + if (phase > 1.0) phase = 1.0; + else if (phase < -1.0) phase = -1.0; + offset = (phase + origin_reg) * time_to_index_reg; + table_index = (long) offset; + if (table_index < 0) { + table_index = 0; + offset = 0; + } + if (table_index >= table_len_reg) { + offset = table_len_reg - 1; + table_index = (long) offset; + } + x1 = fcn_table_reg[table_index]; + *out_ptr_reg++ = (sample_type) (x1 + (offset - table_index) * + (fcn_table_reg[table_index + 1] - x1)); + ; + } while (--n); /* inner loop */ + + susp->origin = origin_reg; + /* using sin_ptr_reg is a bad idea on RS/6000: */ + susp->sin_ptr += togo; + out_ptr += togo; + susp_took(sin_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; + } +} /* shape_s_fetch */ + + +void shape_toss_fetch(susp, snd_list) + register shape_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from sin up to final_time for this block of zeros */ + while ((round((final_time - susp->sin->t0) * susp->sin->sr)) >= + susp->sin->current) + susp_get_samples(sin, sin_ptr, sin_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->sin->t0) * susp->sin->sr - + (susp->sin->current - susp->sin_cnt)); + susp->sin_ptr += n; + susp_took(sin_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void shape_mark(shape_susp_type susp) +{ + sound_xlmark(susp->sin); +} + + +void shape_free(shape_susp_type susp) +{ +table_unref(susp->the_table); sound_unref(susp->sin); + ffree_generic(susp, sizeof(shape_susp_node), "shape_free"); +} + + +void shape_print_tree(shape_susp_type susp, int n) +{ + indent(n); + stdputstr("sin:"); + sound_print_tree_1(susp->sin, n); +} + + +sound_type snd_make_shape(sound_type sin, sound_type fn, double origin) +{ + register shape_susp_type susp; + rate_type sr = sin->sr; + time_type t0 = sin->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, shape_susp_node, "snd_make_shape"); + susp->time_to_index = fn->sr; + susp->origin = origin; + susp->the_table = sound_to_table(fn); + susp->fcn_table = susp->the_table->samples; + susp->table_len = susp->the_table->length; + susp->susp.fetch = shape_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < sin->t0) sound_prepend_zeros(sin, t0); + /* minimum start time over all inputs: */ + t0_min = min(sin->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 = shape_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = shape_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = shape_mark; + susp->susp.print_tree = shape_print_tree; + susp->susp.name = "shape"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(sin); + susp->susp.current = 0; + susp->sin = sin; + susp->sin_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_shape(sound_type sin, sound_type fn, double origin) +{ + sound_type sin_copy = sound_copy(sin); + return snd_make_shape(sin_copy, fn, origin); +} diff --git a/tran/shape.h b/tran/shape.h new file mode 100644 index 0000000..d0ab65e --- /dev/null +++ b/tran/shape.h @@ -0,0 +1,3 @@ +sound_type snd_make_shape(sound_type sin, sound_type fn, double origin); +sound_type snd_shape(sound_type sin, sound_type fn, double origin); + /* LISP: (snd-shape SOUND SOUND ANYNUM) */ diff --git a/tran/sine.alg b/tran/sine.alg new file mode 100644 index 0000000..e00afde --- /dev/null +++ b/tran/sine.alg @@ -0,0 +1,31 @@ +(SINE-ALG +(NAME "sine") +(ARGUMENTS ("time_type" "t0") ("double" "hz") ("rate_type" "sr") ("time_type" "d")) +(STATE ("long" "phase" "0") + ("long" "ph_incr" "round(((hz * SINE_TABLE_LEN) * (1 << SINE_TABLE_SHIFT) / sr))")) +(TERMINATE (AFTER "d")) +(INNER-LOOP "output = sine_table[phase >> SINE_TABLE_SHIFT]; + phase += ph_incr; + phase &= SINE_TABLE_MASK;") +(MAINTAIN ("phase" + "susp->phase = (susp->phase + susp->ph_incr * togo) & SINE_TABLE_MASK")) +(CONSTANT "ph_incr") +(SAMPLE-RATE "sr") +(SUPPORT-HEADER "#define SINE_TABLE_LEN 2048 +#define SINE_TABLE_MASK 0x7FFFFFFF +#define SINE_TABLE_SHIFT 20 +void sine_init(); +extern sample_type sine_table[]; +") +(SUPPORT-FUNCTIONS " +sample_type sine_table[SINE_TABLE_LEN + 1]; + +void sine_init() +{ + int i; + for (i = 0; i <= SINE_TABLE_LEN; i++) + sine_table[i] = (sample_type) (sin((PI * 2 * i) / SINE_TABLE_LEN)); +} +") +) + diff --git a/tran/sine.c b/tran/sine.c new file mode 100644 index 0000000..c84d85f --- /dev/null +++ b/tran/sine.c @@ -0,0 +1,126 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "sine.h" + +void sine_free(); + + +typedef struct sine_susp_struct { + snd_susp_node susp; + long terminate_cnt; + + long phase; + long ph_incr; +} sine_susp_node, *sine_susp_type; + + +sample_type sine_table[SINE_TABLE_LEN + 1]; + +void sine_init() +{ + int i; + for (i = 0; i <= SINE_TABLE_LEN; i++) + sine_table[i] = (sample_type) (sin((PI * 2 * i) / SINE_TABLE_LEN)); +} + + +void sine__fetch(register sine_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 long phase_reg; + register long ph_incr_reg; + falloc_sample_block(out, "sine__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; + } + + n = togo; + phase_reg = susp->phase; + ph_incr_reg = susp->ph_incr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = sine_table[phase_reg >> SINE_TABLE_SHIFT]; + phase_reg += ph_incr_reg; + phase_reg &= SINE_TABLE_MASK;; + } while (--n); /* inner loop */ + + susp->phase = (susp->phase + susp->ph_incr * togo) & SINE_TABLE_MASK; + 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; + } +} /* sine__fetch */ + + +void sine_free(sine_susp_type susp) +{ + ffree_generic(susp, sizeof(sine_susp_node), "sine_free"); +} + + +void sine_print_tree(sine_susp_type susp, int n) +{ +} + + +sound_type snd_make_sine(time_type t0, double hz, rate_type sr, time_type d) +{ + register sine_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, sine_susp_node, "snd_make_sine"); + susp->phase = 0; + susp->ph_incr = round(((hz * SINE_TABLE_LEN) * (1 << SINE_TABLE_SHIFT) / sr)); + susp->susp.fetch = sine__fetch; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = sine_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = sine_print_tree; + susp->susp.name = "sine"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_sine(time_type t0, double hz, rate_type sr, time_type d) +{ + return snd_make_sine(t0, hz, sr, d); +} diff --git a/tran/sine.h b/tran/sine.h new file mode 100644 index 0000000..9c9897d --- /dev/null +++ b/tran/sine.h @@ -0,0 +1,8 @@ +sound_type snd_make_sine(time_type t0, double hz, rate_type sr, time_type d); +sound_type snd_sine(time_type t0, double hz, rate_type sr, time_type d); + /* LISP: (snd-sine ANYNUM ANYNUM ANYNUM ANYNUM) */ +#define SINE_TABLE_LEN 2048 +#define SINE_TABLE_MASK 0x7FFFFFFF +#define SINE_TABLE_SHIFT 20 +void sine_init(); +extern sample_type sine_table[]; diff --git a/tran/siosc.alg b/tran/siosc.alg new file mode 100644 index 0000000..2ec4690 --- /dev/null +++ b/tran/siosc.alg @@ -0,0 +1,131 @@ +(SIOSC-ALG +(NAME "siosc") + +; wave tables are provided in the argument "lis" as follows: +; (tab0 t1 tab1 t2 tab2 t3 tab3 ... tN tabN) +; where tab0 is the initial table, the table is linearly interpolated until +; sample t1, at which point the table is tab1. From there, tab1 is interpolated +; to tab2 at t2, etc. The sound stops at the terminate time of s_fm, so +; if that comes before tN, tabN is used for the remainder of the sound. +; t1, t2, ... tN are fixnums with sample counts + +(ARGUMENTS ("LVAL" "lis") ("rate_type" "sr") + ("double" "hz") ("time_type" "t0") ("sound_type" "s_fm")) +(SUPPORT-FUNCTIONS " +/* sisosc_table_init -- set up first two tables for interpolation */ +/**/ +void siosc_table_init(siosc_susp_type susp) +{ + sound_type snd; + if (!susp->lis) xlfail(\"bad table list in SIOSC\"); + snd = getsound(car(susp->lis)); + susp->table_b_ptr_ptr = sound_to_table(snd); + susp->table_b_samps = susp->table_b_ptr_ptr->samples; + susp->lis = cdr(susp->lis); + susp->table_sr = snd->sr; + susp->table_len = susp->table_b_ptr_ptr->length; +} + +/* siosc_table_update -- outer loop processing, get next table */ +/**/ +long siosc_table_update(siosc_susp_type susp, long cur) +{ + long n; + + /* swap ampramps: */ + susp->ampramp_a = 1.0; + susp->ampramp_b = 0.0; + + /* swap tables: */ + table_unref(susp->table_a_ptr); + susp->table_a_ptr = susp->table_b_ptr_ptr; + susp->table_a_samps = susp->table_b_samps; + susp->table_b_ptr_ptr = NULL; /* so we do not try to unref it */ + + if (susp->lis) { + sound_type snd; + + /* compute slope */ + susp->next_breakpoint = getfixnum(car(susp->lis)); + susp->lis = cdr(susp->lis); + n = susp->next_breakpoint - cur; + susp->ampslope = 1.0 / n; + + /* build new table: */ + if (!susp->lis) xlfail(\"bad table list in SIOSC\"); + snd = getsound(car(susp->lis)); + susp->table_b_ptr_ptr = sound_to_table(snd); + susp->table_b_samps = susp->table_b_ptr_ptr->samples; + if (susp->table_b_ptr_ptr->length != susp->table_len || susp->table_sr != snd->sr) + xlfail(\"mismatched tables passed to SIOSC\") ; + susp->lis = cdr(susp->lis); + } else { /* use only table a */ + susp->ampslope = 0.0; + susp->next_breakpoint = 0x7FFFFFFF; + n = 0x7FFFFFFF; + } + return n; +} +") + +(STATE ("double" "table_len" "0.0") + ("double" "ph_incr" "0.0") + ("table_type" "table_a_ptr" "NULL") + ("table_type" "table_b_ptr_ptr" "NULL") + ("sample_type *" "table_a_samps" "NULL") + ("sample_type *" "table_b_samps" "NULL") + ("double" "table_sr" "0.0") + ("double" "phase" "0.0") + ("LVAL" "lis" "lis") + ("long" "next_breakpoint" "0") + ("double" "ampramp_a" "1.0") + ("double" "ampramp_b" "0.0") + ("double" "ampslope" "0.0; + siosc_table_init(susp); + susp->ph_incr = hz * susp->table_len / sr; + s_fm->scale = (sample_type) (s_fm->scale * (susp->table_len / sr))") +) + +(ALWAYS-SCALE s_fm) +(INLINE-INTERPOLATION T) ; so that modulation can be low frequency +(STEP-FUNCTION s_fm) +(TERMINATE (MIN s_fm)) +(LOGICAL-STOP (MIN s_fm)) +(INNER-LOOP-LOCALS " long table_index; + double xa, xb; +") + +; Implementation notes: +; "lis" points to the next time to be used, or NULL + +(OUTER-LOOP " + { long cur = susp->susp.current + cnt; + n = susp->next_breakpoint - cur; + if (n == 0) n = siosc_table_update(susp, cur); + } + togo = min(n, togo); +") + +(INNER-LOOP " table_index = (long) phase; + xa = table_a_samps[table_index]; + xb = table_b_samps[table_index]; + output = (sample_type) + (ampramp_a * (xa + (phase - table_index) * + (table_a_samps[table_index + 1] - xa)) + + ampramp_b * (xb + (phase - table_index) * + (table_b_samps[table_index + 1] - xb))); + ampramp_a -= ampslope; + ampramp_b += ampslope; + phase += ph_incr + s_fm; + while (phase > table_len) phase -= table_len; + /* watch out for negative frequencies! */ + while (phase < 0) phase += table_len") +(CONSTANT "ph_incr" "table_len" "table_ptr" "table_a_samps" + "table_b_samps" "ampslope" "table_a_ptr" "table_b_ptr_ptr") + +(SAMPLE-RATE "sr") +(FINALIZATION " table_unref(susp->table_a_ptr); + table_unref(susp->table_b_ptr_ptr); +") +) + diff --git a/tran/siosc.c b/tran/siosc.c new file mode 100644 index 0000000..f4a0b44 --- /dev/null +++ b/tran/siosc.c @@ -0,0 +1,637 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "siosc.h" + +void siosc_free(); + + +typedef struct siosc_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s_fm; + long s_fm_cnt; + sample_block_values_type s_fm_ptr; + + /* support for interpolation of s_fm */ + sample_type s_fm_x1_sample; + double s_fm_pHaSe; + double s_fm_pHaSe_iNcR; + + /* support for ramp between samples of s_fm */ + double output_per_s_fm; + long s_fm_n; + + double table_len; + double ph_incr; + table_type table_a_ptr; + table_type table_b_ptr_ptr; + sample_type *table_a_samps; + sample_type *table_b_samps; + double table_sr; + double phase; + LVAL lis; + long next_breakpoint; + double ampramp_a; + double ampramp_b; + double ampslope; +} siosc_susp_node, *siosc_susp_type; + + +/* sisosc_table_init -- set up first two tables for interpolation */ +/**/ +void siosc_table_init(siosc_susp_type susp) +{ + sound_type snd; + if (!susp->lis) xlfail("bad table list in SIOSC"); + snd = getsound(car(susp->lis)); + susp->table_b_ptr_ptr = sound_to_table(snd); + susp->table_b_samps = susp->table_b_ptr_ptr->samples; + susp->lis = cdr(susp->lis); + susp->table_sr = snd->sr; + susp->table_len = susp->table_b_ptr_ptr->length; +} + +/* siosc_table_update -- outer loop processing, get next table */ +/**/ +long siosc_table_update(siosc_susp_type susp, long cur) +{ + long n; + + /* swap ampramps: */ + susp->ampramp_a = 1.0; + susp->ampramp_b = 0.0; + + /* swap tables: */ + table_unref(susp->table_a_ptr); + susp->table_a_ptr = susp->table_b_ptr_ptr; + susp->table_a_samps = susp->table_b_samps; + susp->table_b_ptr_ptr = NULL; /* so we do not try to unref it */ + + if (susp->lis) { + sound_type snd; + + /* compute slope */ + susp->next_breakpoint = getfixnum(car(susp->lis)); + susp->lis = cdr(susp->lis); + n = susp->next_breakpoint - cur; + susp->ampslope = 1.0 / n; + + /* build new table: */ + if (!susp->lis) xlfail("bad table list in SIOSC"); + snd = getsound(car(susp->lis)); + susp->table_b_ptr_ptr = sound_to_table(snd); + susp->table_b_samps = susp->table_b_ptr_ptr->samples; + if (susp->table_b_ptr_ptr->length != susp->table_len || susp->table_sr != snd->sr) + xlfail("mismatched tables passed to SIOSC") ; + susp->lis = cdr(susp->lis); + } else { /* use only table a */ + susp->ampslope = 0.0; + susp->next_breakpoint = 0x7FFFFFFF; + n = 0x7FFFFFFF; + } + return n; +} + + +void siosc_s_fetch(register siosc_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 double table_len_reg; + register double ph_incr_reg; + register sample_type * table_a_samps_reg; + register sample_type * table_b_samps_reg; + register double phase_reg; + register double ampramp_a_reg; + register double ampramp_b_reg; + register double ampslope_reg; + register sample_type s_fm_scale_reg = susp->s_fm->scale; + register sample_block_values_type s_fm_ptr_reg; + falloc_sample_block(out, "siosc_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 s_fm input sample block: */ + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + togo = min(togo, susp->s_fm_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; + } + } + + + { long cur = susp->susp.current + cnt; + n = susp->next_breakpoint - cur; + if (n == 0) n = siosc_table_update(susp, cur); + } + togo = min(n, togo); + + n = togo; + table_len_reg = susp->table_len; + ph_incr_reg = susp->ph_incr; + table_a_samps_reg = susp->table_a_samps; + table_b_samps_reg = susp->table_b_samps; + phase_reg = susp->phase; + ampramp_a_reg = susp->ampramp_a; + ampramp_b_reg = susp->ampramp_b; + ampslope_reg = susp->ampslope; + s_fm_ptr_reg = susp->s_fm_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double xa, xb; + table_index = (long) phase_reg; + xa = table_a_samps_reg[table_index]; + xb = table_b_samps_reg[table_index]; + *out_ptr_reg++ = (sample_type) + (ampramp_a_reg * (xa + (phase_reg - table_index) * + (table_a_samps_reg[table_index + 1] - xa)) + + ampramp_b_reg * (xb + (phase_reg - table_index) * + (table_b_samps_reg[table_index + 1] - xb))); + ampramp_a_reg -= ampslope_reg; + ampramp_b_reg += ampslope_reg; + phase_reg += ph_incr_reg + (s_fm_scale_reg * *s_fm_ptr_reg++); + while (phase_reg > table_len_reg) phase_reg -= table_len_reg; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += table_len_reg; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + susp->ampramp_a = ampramp_a_reg; + susp->ampramp_b = ampramp_b_reg; + /* using s_fm_ptr_reg is a bad idea on RS/6000: */ + susp->s_fm_ptr += togo; + out_ptr += togo; + susp_took(s_fm_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; + } +} /* siosc_s_fetch */ + + +void siosc_i_fetch(register siosc_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 double table_len_reg; + register double ph_incr_reg; + register sample_type * table_a_samps_reg; + register sample_type * table_b_samps_reg; + register double phase_reg; + register double ampramp_a_reg; + register double ampramp_b_reg; + register double ampslope_reg; + register double s_fm_pHaSe_iNcR_rEg = susp->s_fm_pHaSe_iNcR; + register double s_fm_pHaSe_ReG; + register sample_type s_fm_x1_sample_reg; + falloc_sample_block(out, "siosc_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_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + } + + 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); + /* 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; + } + } + + + { long cur = susp->susp.current + cnt; + n = susp->next_breakpoint - cur; + if (n == 0) n = siosc_table_update(susp, cur); + } + togo = min(n, togo); + + n = togo; + table_len_reg = susp->table_len; + ph_incr_reg = susp->ph_incr; + table_a_samps_reg = susp->table_a_samps; + table_b_samps_reg = susp->table_b_samps; + phase_reg = susp->phase; + ampramp_a_reg = susp->ampramp_a; + ampramp_b_reg = susp->ampramp_b; + ampslope_reg = susp->ampslope; + s_fm_pHaSe_ReG = susp->s_fm_pHaSe; + s_fm_x1_sample_reg = susp->s_fm_x1_sample; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double xa, xb; + if (s_fm_pHaSe_ReG >= 1.0) { +/* fixup-depends s_fm */ + /* pick up next sample as s_fm_x1_sample: */ + susp->s_fm_ptr++; + susp_took(s_fm_cnt, 1); + s_fm_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(s_fm, s_fm_ptr, s_fm_cnt, s_fm_x1_sample_reg); + s_fm_x1_sample_reg = susp_current_sample(s_fm, s_fm_ptr); + } + table_index = (long) phase_reg; + xa = table_a_samps_reg[table_index]; + xb = table_b_samps_reg[table_index]; + *out_ptr_reg++ = (sample_type) + (ampramp_a_reg * (xa + (phase_reg - table_index) * + (table_a_samps_reg[table_index + 1] - xa)) + + ampramp_b_reg * (xb + (phase_reg - table_index) * + (table_b_samps_reg[table_index + 1] - xb))); + ampramp_a_reg -= ampslope_reg; + ampramp_b_reg += ampslope_reg; + phase_reg += ph_incr_reg + s_fm_x1_sample_reg; + while (phase_reg > table_len_reg) phase_reg -= table_len_reg; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += table_len_reg; + s_fm_pHaSe_ReG += s_fm_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->phase = phase_reg; + susp->ampramp_a = ampramp_a_reg; + susp->ampramp_b = ampramp_b_reg; + susp->s_fm_pHaSe = s_fm_pHaSe_ReG; + susp->s_fm_x1_sample = s_fm_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; + } +} /* siosc_i_fetch */ + + +void siosc_r_fetch(register siosc_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type s_fm_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double table_len_reg; + register double ph_incr_reg; + register sample_type * table_a_samps_reg; + register sample_type * table_b_samps_reg; + register double phase_reg; + register double ampramp_a_reg; + register double ampramp_b_reg; + register double ampslope_reg; + falloc_sample_block(out, "siosc_r_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->s_fm_pHaSe = 1.0; + } + + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + + 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; + + /* grab next s_fm_x1_sample when phase goes past 1.0; */ + /* use s_fm_n (computed below) to avoid roundoff errors: */ + if (susp->s_fm_n <= 0) { + susp_check_term_log_samples(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_x1_sample = susp_fetch_sample(s_fm, s_fm_ptr, s_fm_cnt); + susp->s_fm_pHaSe -= 1.0; + /* s_fm_n gets number of samples before phase exceeds 1.0: */ + susp->s_fm_n = (long) ((1.0 - susp->s_fm_pHaSe) * + susp->output_per_s_fm); + } + togo = min(togo, susp->s_fm_n); + s_fm_val = susp->s_fm_x1_sample; + /* 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; + } + } + + + { long cur = susp->susp.current + cnt; + n = susp->next_breakpoint - cur; + if (n == 0) n = siosc_table_update(susp, cur); + } + togo = min(n, togo); + + n = togo; + table_len_reg = susp->table_len; + ph_incr_reg = susp->ph_incr; + table_a_samps_reg = susp->table_a_samps; + table_b_samps_reg = susp->table_b_samps; + phase_reg = susp->phase; + ampramp_a_reg = susp->ampramp_a; + ampramp_b_reg = susp->ampramp_b; + ampslope_reg = susp->ampslope; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long table_index; + double xa, xb; + table_index = (long) phase_reg; + xa = table_a_samps_reg[table_index]; + xb = table_b_samps_reg[table_index]; + *out_ptr_reg++ = (sample_type) + (ampramp_a_reg * (xa + (phase_reg - table_index) * + (table_a_samps_reg[table_index + 1] - xa)) + + ampramp_b_reg * (xb + (phase_reg - table_index) * + (table_b_samps_reg[table_index + 1] - xb))); + ampramp_a_reg -= ampslope_reg; + ampramp_b_reg += ampslope_reg; + phase_reg += ph_incr_reg + s_fm_val; + while (phase_reg > table_len_reg) phase_reg -= table_len_reg; + /* watch out for negative frequencies! */ + while (phase_reg < 0) phase_reg += table_len_reg; + } while (--n); /* inner loop */ + + susp->phase = phase_reg; + susp->ampramp_a = ampramp_a_reg; + susp->ampramp_b = ampramp_b_reg; + out_ptr += togo; + susp->s_fm_pHaSe += togo * susp->s_fm_pHaSe_iNcR; + susp->s_fm_n -= 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; + } +} /* siosc_r_fetch */ + + +void siosc_toss_fetch(susp, snd_list) + register siosc_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s_fm up to final_time for this block of zeros */ + while ((round((final_time - susp->s_fm->t0) * susp->s_fm->sr)) >= + susp->s_fm->current) + susp_get_samples(s_fm, s_fm_ptr, s_fm_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s_fm->t0) * susp->s_fm->sr - + (susp->s_fm->current - susp->s_fm_cnt)); + susp->s_fm_ptr += n; + susp_took(s_fm_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void siosc_mark(siosc_susp_type susp) +{ + if (susp->lis) mark(susp->lis); + sound_xlmark(susp->s_fm); +} + + +void siosc_free(siosc_susp_type susp) +{ + table_unref(susp->table_a_ptr); + table_unref(susp->table_b_ptr_ptr); + sound_unref(susp->s_fm); + ffree_generic(susp, sizeof(siosc_susp_node), "siosc_free"); +} + + +void siosc_print_tree(siosc_susp_type susp, int n) +{ + indent(n); + stdputstr("s_fm:"); + sound_print_tree_1(susp->s_fm, n); +} + + +sound_type snd_make_siosc(LVAL lis, rate_type sr, double hz, time_type t0, sound_type s_fm) +{ + register siosc_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, siosc_susp_node, "snd_make_siosc"); + susp->table_len = 0.0; + susp->ph_incr = 0.0; + susp->table_a_ptr = NULL; + susp->table_b_ptr_ptr = NULL; + susp->table_a_samps = NULL; + susp->table_b_samps = NULL; + susp->table_sr = 0.0; + susp->phase = 0.0; + susp->lis = lis; + susp->next_breakpoint = 0; + susp->ampramp_a = 1.0; + susp->ampramp_b = 0.0; + susp->ampslope = 0.0; + siosc_table_init(susp); + susp->ph_incr = hz * susp->table_len / sr; + s_fm->scale = (sample_type) (s_fm->scale * (susp->table_len / sr)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s_fm, sr); + switch (interp_desc) { + case INTERP_n: /* handled below */ + case INTERP_s: susp->susp.fetch = siosc_s_fetch; break; + case INTERP_i: susp->susp.fetch = siosc_i_fetch; break; + case INTERP_r: susp->susp.fetch = siosc_r_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s_fm->t0) sound_prepend_zeros(s_fm, t0); + /* minimum start time over all inputs: */ + t0_min = min(s_fm->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 = siosc_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = siosc_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = siosc_mark; + susp->susp.print_tree = siosc_print_tree; + susp->susp.name = "siosc"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s_fm); + susp->started = false; + susp->susp.current = 0; + susp->s_fm = s_fm; + susp->s_fm_cnt = 0; + susp->s_fm_pHaSe = 0.0; + susp->s_fm_pHaSe_iNcR = s_fm->sr / sr; + susp->s_fm_n = 0; + susp->output_per_s_fm = sr / s_fm->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_siosc(LVAL lis, rate_type sr, double hz, time_type t0, sound_type s_fm) +{ + sound_type s_fm_copy = sound_copy(s_fm); + return snd_make_siosc(lis, sr, hz, t0, s_fm_copy); +} diff --git a/tran/siosc.h b/tran/siosc.h new file mode 100644 index 0000000..5507075 --- /dev/null +++ b/tran/siosc.h @@ -0,0 +1,3 @@ +sound_type snd_make_siosc(LVAL lis, rate_type sr, double hz, time_type t0, sound_type s_fm); +sound_type snd_siosc(LVAL lis, rate_type sr, double hz, time_type t0, sound_type s_fm); + /* LISP: (snd-siosc ANY ANYNUM ANYNUM ANYNUM SOUND) */ diff --git a/tran/slope.alg b/tran/slope.alg new file mode 100644 index 0000000..7b0cb2b --- /dev/null +++ b/tran/slope.alg @@ -0,0 +1,15 @@ +(SLOPE-ALG + (NAME "slope") + (ARGUMENTS ("sound_type" "input")) + (STATE ("sample_type" "prev" "0.0F") + ("double" "scale" "input->sr * input->scale")) + (INTERNAL-SCALING input) + (CONSTANT "scale") + (DELAY 1) + (START (MIN input)) + (INNER-LOOP "{ register sample_type x = input; +output = (sample_type) ((x - prev) * scale); +prev = x;}") + (TERMINATE (MIN input)) + (LOGICAL-STOP (MIN input)) +) diff --git a/tran/slope.c b/tran/slope.c new file mode 100644 index 0000000..2ed5846 --- /dev/null +++ b/tran/slope.c @@ -0,0 +1,210 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "slope.h" + +void slope_free(); + + +typedef struct slope_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + sample_type prev; + double scale; +} slope_susp_node, *slope_susp_type; + + +void slope_n_fetch(register slope_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 prev_reg; + register double scale_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "slope_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + prev_reg = susp->prev; + scale_reg = susp->scale; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ register sample_type x = *input_ptr_reg++; +*out_ptr_reg++ = (sample_type) ((x - prev_reg) * scale_reg); +prev_reg = x;}; + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* slope_n_fetch */ + + +void slope_toss_fetch(susp, snd_list) + register slope_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void slope_mark(slope_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void slope_free(slope_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(slope_susp_node), "slope_free"); +} + + +void slope_print_tree(slope_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_slope(sound_type input) +{ + register slope_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, slope_susp_node, "snd_make_slope"); + susp->prev = 0.0F; + susp->scale = input->sr * input->scale; + susp->susp.fetch = slope_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->t0, t0); + /* how many samples to toss before t0: */ + /* Toss an extra 1 samples to make up for internal buffering: */ + susp->susp.toss_cnt = (long) ((t0 - t0_min) * sr + 1.5); + if (susp->susp.toss_cnt > 0) { + susp->susp.keep_fetch = susp->susp.fetch; + susp->susp.fetch = slope_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = slope_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = slope_mark; + susp->susp.print_tree = slope_print_tree; + susp->susp.name = "slope"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_slope(sound_type input) +{ + sound_type input_copy = sound_copy(input); + return snd_make_slope(input_copy); +} diff --git a/tran/slope.h b/tran/slope.h new file mode 100644 index 0000000..39cafaf --- /dev/null +++ b/tran/slope.h @@ -0,0 +1,3 @@ +sound_type snd_make_slope(sound_type input); +sound_type snd_slope(sound_type input); + /* LISP: (snd-slope SOUND) */ diff --git a/tran/sqrt.alg b/tran/sqrt.alg new file mode 100644 index 0000000..5c392a3 --- /dev/null +++ b/tran/sqrt.alg @@ -0,0 +1,9 @@ +(SQRT-ALG + (NAME "sqrt") + (ARGUMENTS ("sound_type" "input")) + (ALWAYS-SCALE input) + (START (MIN input)) + (INNER-LOOP "{ sample_type i = input; if (i < 0) i = 0; output = (sample_type) sqrt(i); }") + (TERMINATE (MIN input)) + (LOGICAL-STOP (MIN input)) +) diff --git a/tran/sqrt.c b/tran/sqrt.c new file mode 100644 index 0000000..66b2ae7 --- /dev/null +++ b/tran/sqrt.c @@ -0,0 +1,198 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "sqrt.h" + +void sqrt_free(); + + +typedef struct sqrt_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; +} sqrt_susp_node, *sqrt_susp_type; + + +void sqrt_s_fetch(register sqrt_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 input_scale_reg = susp->input->scale; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "sqrt_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +{ sample_type i = (input_scale_reg * *input_ptr_reg++); if (i < 0) i = 0; *out_ptr_reg++ = (sample_type) sqrt(i); }; + } while (--n); /* inner loop */ + + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* sqrt_s_fetch */ + + +void sqrt_toss_fetch(susp, snd_list) + register sqrt_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void sqrt_mark(sqrt_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void sqrt_free(sqrt_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(sqrt_susp_node), "sqrt_free"); +} + + +void sqrt_print_tree(sqrt_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_sqrt(sound_type input) +{ + register sqrt_susp_type susp; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, sqrt_susp_node, "snd_make_sqrt"); + susp->susp.fetch = sqrt_s_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = sqrt_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = sqrt_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = sqrt_mark; + susp->susp.print_tree = sqrt_print_tree; + susp->susp.name = "sqrt"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_sqrt(sound_type input) +{ + sound_type input_copy = sound_copy(input); + return snd_make_sqrt(input_copy); +} diff --git a/tran/sqrt.h b/tran/sqrt.h new file mode 100644 index 0000000..ab47c6f --- /dev/null +++ b/tran/sqrt.h @@ -0,0 +1,3 @@ +sound_type snd_make_sqrt(sound_type input); +sound_type snd_sqrt(sound_type input); + /* LISP: (snd-sqrt SOUND) */ diff --git a/tran/stkchorus.alg b/tran/stkchorus.alg new file mode 100644 index 0000000..3e3e19a --- /dev/null +++ b/tran/stkchorus.alg @@ -0,0 +1,21 @@ +(STKCHORUS-ALG +(NAME "stkchorus") +(ARGUMENTS ("sound_type" "s1")("double" "baseDelay")("double" "depth")("double" "freq") + ("double" "mix")("rate_type" "sr")) +(STATE ("struct stkEffect *" "mych" "initStkChorus(baseDelay, depth, freq, round(sr)); +stkEffectSetMix(susp->mych, mix)")) +(START (MIN s1)) +(TERMINATE (MIN s1)) +(LOGICAL-STOP (MIN s1)) +(NOT-IN-INNER-LOOP "mych" "baseDelay" "depth" "freq" "mix" "sr") +(SAMPLE-RATE "sr") +(SUPPORT-FUNCTIONS " + #include \"stkint.h\" +") +(INNER-LOOP " + output = (sample_type) (stkEffectTick(mych, s1)) +") +(FINALIZATION " + deleteStkEffect(susp->mych); +") +)
\ No newline at end of file diff --git a/tran/stkchorus.c b/tran/stkchorus.c new file mode 100644 index 0000000..a66fc07 --- /dev/null +++ b/tran/stkchorus.c @@ -0,0 +1,311 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "stkchorus.h" + +void stkchorus_free(); + + +typedef struct stkchorus_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + + struct stkEffect *mych; +} stkchorus_susp_node, *stkchorus_susp_type; + + + #include "stkint.h" + + +void stkchorus_n_fetch(register stkchorus_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 struct stkEffect * mych_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "stkchorus_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + mych_reg = susp->mych; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) (stkEffectTick(mych_reg, *s1_ptr_reg++)) +; + } while (--n); /* inner loop */ + + susp->mych = mych_reg; + /* using s1_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 */ + + /* 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; + } +} /* stkchorus_n_fetch */ + + +void stkchorus_s_fetch(register stkchorus_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 struct stkEffect * mych_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "stkchorus_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + mych_reg = susp->mych; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) (stkEffectTick(mych_reg, (s1_scale_reg * *s1_ptr_reg++))) +; + } while (--n); /* inner loop */ + + susp->mych = mych_reg; + /* using s1_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 */ + + /* 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; + } +} /* stkchorus_s_fetch */ + + +void stkchorus_toss_fetch(susp, snd_list) + register stkchorus_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void stkchorus_mark(stkchorus_susp_type susp) +{ + sound_xlmark(susp->s1); +} + + +void stkchorus_free(stkchorus_susp_type susp) +{ + + deleteStkEffect(susp->mych); + sound_unref(susp->s1); + ffree_generic(susp, sizeof(stkchorus_susp_node), "stkchorus_free"); +} + + +void stkchorus_print_tree(stkchorus_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); +} + + +sound_type snd_make_stkchorus(sound_type s1, double baseDelay, double depth, double freq, double mix, rate_type sr) +{ + register stkchorus_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = s1->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, stkchorus_susp_node, "snd_make_stkchorus"); + susp->mych = initStkChorus(baseDelay, depth, freq, round(sr)); +stkEffectSetMix(susp->mych, mix); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = stkchorus_n_fetch; break; + case INTERP_s: susp->susp.fetch = stkchorus_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->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 = stkchorus_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = stkchorus_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = stkchorus_mark; + susp->susp.print_tree = stkchorus_print_tree; + susp->susp.name = "stkchorus"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_stkchorus(sound_type s1, double baseDelay, double depth, double freq, double mix, rate_type sr) +{ + sound_type s1_copy = sound_copy(s1); + return snd_make_stkchorus(s1_copy, baseDelay, depth, freq, mix, sr); +} diff --git a/tran/stkchorus.h b/tran/stkchorus.h new file mode 100644 index 0000000..5bbd13a --- /dev/null +++ b/tran/stkchorus.h @@ -0,0 +1,3 @@ +sound_type snd_make_stkchorus(sound_type s1, double baseDelay, double depth, double freq, double mix, rate_type sr); +sound_type snd_stkchorus(sound_type s1, double baseDelay, double depth, double freq, double mix, rate_type sr); + /* LISP: (snd-stkchorus SOUND ANYNUM ANYNUM ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/stkpitshift.alg b/tran/stkpitshift.alg new file mode 100644 index 0000000..0c7b2ac --- /dev/null +++ b/tran/stkpitshift.alg @@ -0,0 +1,20 @@ +(STKPITSHIFT-ALG +(NAME "stkpitshift") +(ARGUMENTS ("sound_type" "s1")("double" "shift")("double" "mix")("rate_type" "sr")) +(STATE ("struct stkEffect *" "mych" "initStkPitShift(shift, round(sr)); +stkEffectSetMix(susp->mych, mix)")) +(START (MIN s1)) +(TERMINATE (MIN s1)) +(LOGICAL-STOP (MIN s1)) +(NOT-IN-INNER-LOOP "mych" "shift" "mix" "sr") +(SAMPLE-RATE "sr") +(SUPPORT-FUNCTIONS " + #include \"stkint.h\" +") +(INNER-LOOP " + output = (sample_type) (stkEffectTick(mych, s1)) +") +(FINALIZATION " + deleteStkEffect(susp->mych); +") +)
\ No newline at end of file diff --git a/tran/stkpitshift.c b/tran/stkpitshift.c new file mode 100644 index 0000000..586bab4 --- /dev/null +++ b/tran/stkpitshift.c @@ -0,0 +1,311 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "stkpitshift.h" + +void stkpitshift_free(); + + +typedef struct stkpitshift_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + + struct stkEffect *mych; +} stkpitshift_susp_node, *stkpitshift_susp_type; + + + #include "stkint.h" + + +void stkpitshift_n_fetch(register stkpitshift_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 struct stkEffect * mych_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "stkpitshift_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + mych_reg = susp->mych; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) (stkEffectTick(mych_reg, *s1_ptr_reg++)) +; + } while (--n); /* inner loop */ + + susp->mych = mych_reg; + /* using s1_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 */ + + /* 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; + } +} /* stkpitshift_n_fetch */ + + +void stkpitshift_s_fetch(register stkpitshift_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 struct stkEffect * mych_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "stkpitshift_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + mych_reg = susp->mych; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) (stkEffectTick(mych_reg, (s1_scale_reg * *s1_ptr_reg++))) +; + } while (--n); /* inner loop */ + + susp->mych = mych_reg; + /* using s1_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 */ + + /* 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; + } +} /* stkpitshift_s_fetch */ + + +void stkpitshift_toss_fetch(susp, snd_list) + register stkpitshift_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void stkpitshift_mark(stkpitshift_susp_type susp) +{ + sound_xlmark(susp->s1); +} + + +void stkpitshift_free(stkpitshift_susp_type susp) +{ + + deleteStkEffect(susp->mych); + sound_unref(susp->s1); + ffree_generic(susp, sizeof(stkpitshift_susp_node), "stkpitshift_free"); +} + + +void stkpitshift_print_tree(stkpitshift_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); +} + + +sound_type snd_make_stkpitshift(sound_type s1, double shift, double mix, rate_type sr) +{ + register stkpitshift_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = s1->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, stkpitshift_susp_node, "snd_make_stkpitshift"); + susp->mych = initStkPitShift(shift, round(sr)); +stkEffectSetMix(susp->mych, mix); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = stkpitshift_n_fetch; break; + case INTERP_s: susp->susp.fetch = stkpitshift_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->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 = stkpitshift_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = stkpitshift_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = stkpitshift_mark; + susp->susp.print_tree = stkpitshift_print_tree; + susp->susp.name = "stkpitshift"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_stkpitshift(sound_type s1, double shift, double mix, rate_type sr) +{ + sound_type s1_copy = sound_copy(s1); + return snd_make_stkpitshift(s1_copy, shift, mix, sr); +} diff --git a/tran/stkpitshift.h b/tran/stkpitshift.h new file mode 100644 index 0000000..ff9c16e --- /dev/null +++ b/tran/stkpitshift.h @@ -0,0 +1,3 @@ +sound_type snd_make_stkpitshift(sound_type s1, double shift, double mix, rate_type sr); +sound_type snd_stkpitshift(sound_type s1, double shift, double mix, rate_type sr); + /* LISP: (snd-stkpitshift SOUND ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/stkrev.alg b/tran/stkrev.alg new file mode 100644 index 0000000..b4704ad --- /dev/null +++ b/tran/stkrev.alg @@ -0,0 +1,20 @@ +(STKREV-ALG +(NAME "stkrev") +(ARGUMENTS ("int" "rev_type")("sound_type" "s1")("time_type" "trev")("double" "mix")("rate_type" "sr")) +(STATE ("struct stkEffect *" "myrv" "initStkEffect(rev_type, trev, round(sr)); +stkEffectSetMix(susp->myrv, mix)")) +(START (MIN s1)) +(TERMINATE (MIN s1)) +(LOGICAL-STOP (MIN s1)) +(NOT-IN-INNER-LOOP "myrv" "trev") +(SAMPLE-RATE "sr") +(SUPPORT-FUNCTIONS " + #include \"stkint.h\" +") +(INNER-LOOP " + output = (sample_type) (stkEffectTick(myrv, s1)) +") +(FINALIZATION " + deleteStkEffect(susp->myrv); +") +)
\ No newline at end of file diff --git a/tran/stkrev.c b/tran/stkrev.c new file mode 100644 index 0000000..36490d7 --- /dev/null +++ b/tran/stkrev.c @@ -0,0 +1,311 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "stkrev.h" + +void stkrev_free(); + + +typedef struct stkrev_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + + struct stkEffect *myrv; +} stkrev_susp_node, *stkrev_susp_type; + + + #include "stkint.h" + + +void stkrev_n_fetch(register stkrev_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 struct stkEffect * myrv_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "stkrev_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + myrv_reg = susp->myrv; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) (stkEffectTick(myrv_reg, *s1_ptr_reg++)) +; + } while (--n); /* inner loop */ + + susp->myrv = myrv_reg; + /* using s1_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 */ + + /* 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; + } +} /* stkrev_n_fetch */ + + +void stkrev_s_fetch(register stkrev_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 struct stkEffect * myrv_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "stkrev_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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + myrv_reg = susp->myrv; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + + *out_ptr_reg++ = (sample_type) (stkEffectTick(myrv_reg, (s1_scale_reg * *s1_ptr_reg++))) +; + } while (--n); /* inner loop */ + + susp->myrv = myrv_reg; + /* using s1_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 */ + + /* 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; + } +} /* stkrev_s_fetch */ + + +void stkrev_toss_fetch(susp, snd_list) + register stkrev_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void stkrev_mark(stkrev_susp_type susp) +{ + sound_xlmark(susp->s1); +} + + +void stkrev_free(stkrev_susp_type susp) +{ + + deleteStkEffect(susp->myrv); + sound_unref(susp->s1); + ffree_generic(susp, sizeof(stkrev_susp_node), "stkrev_free"); +} + + +void stkrev_print_tree(stkrev_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); +} + + +sound_type snd_make_stkrev(int rev_type, sound_type s1, time_type trev, double mix, rate_type sr) +{ + register stkrev_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = s1->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, stkrev_susp_node, "snd_make_stkrev"); + susp->myrv = initStkEffect(rev_type, trev, round(sr)); +stkEffectSetMix(susp->myrv, mix); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = stkrev_n_fetch; break; + case INTERP_s: susp->susp.fetch = stkrev_s_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->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 = stkrev_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = stkrev_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = stkrev_mark; + susp->susp.print_tree = stkrev_print_tree; + susp->susp.name = "stkrev"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_stkrev(int rev_type, sound_type s1, time_type trev, double mix, rate_type sr) +{ + sound_type s1_copy = sound_copy(s1); + return snd_make_stkrev(rev_type, s1_copy, trev, mix, sr); +} diff --git a/tran/stkrev.h b/tran/stkrev.h new file mode 100644 index 0000000..09926c6 --- /dev/null +++ b/tran/stkrev.h @@ -0,0 +1,3 @@ +sound_type snd_make_stkrev(int rev_type, sound_type s1, time_type trev, double mix, rate_type sr); +sound_type snd_stkrev(int rev_type, sound_type s1, time_type trev, double mix, rate_type sr); + /* LISP: (snd-stkrev FIXNUM SOUND ANYNUM ANYNUM ANYNUM) */ diff --git a/tran/tapf.alg b/tran/tapf.alg new file mode 100644 index 0000000..90175e0 --- /dev/null +++ b/tran/tapf.alg @@ -0,0 +1,49 @@ +(TAPF-ALG +(NAME "tapf") +(ARGUMENTS ("sound_type" "s1") ("double" "offset") ("sound_type" "vardelay") + ("double" "maxdelay")) +(INLINE-INTERPOLATION T) +(STEP-FUNCTION "vardelay") +(INTERNAL-SCALING vardelay) +(ALWAYS-SCALE s1) +(START (MAX s1 vardelay)) +(TERMINATE (MIN s1 vardelay)) +(LOGICAL-STOP (MIN s1)) +(STATE ("double" "offset" "offset * s1->sr") + ("double" "vdscale" "vardelay->scale * s1->sr") + ("long" "maxdelay" "(long)(maxdelay * s1->sr)") + ("long" "bufflen" "max(2, (long) (susp->maxdelay + 0.5))") + ("long" "index" "susp->bufflen") + ("sample_type *" "buffer" + "(sample_type *) calloc(susp->bufflen + 1, sizeof(sample_type))")) +(SAMPLE-RATE (MAX s1)) +(CONSTANT "maxdelay" "offset" "vdscale" "buffer") +(INNER-LOOP-LOCALS " long phase; +") +(INNER-LOOP " phase = (long) (vardelay * vdscale + offset); + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay) phase = maxdelay; + phase = index - phase; + /* now phase is a location in the buffer (before modulo) */ + + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer[index++] = s1; + if (index >= bufflen) { + index = 0; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen; + output = (sample_type) (buffer[phase]);") +(FINALIZATION " free(susp->buffer); +") +) + diff --git a/tran/tapf.c b/tran/tapf.c new file mode 100644 index 0000000..c7c4556 --- /dev/null +++ b/tran/tapf.c @@ -0,0 +1,619 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "tapf.h" + +void tapf_free(); + + +typedef struct tapf_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type vardelay; + long vardelay_cnt; + sample_block_values_type vardelay_ptr; + + /* support for interpolation of vardelay */ + sample_type vardelay_x1_sample; + double vardelay_pHaSe; + double vardelay_pHaSe_iNcR; + + /* support for ramp between samples of vardelay */ + double output_per_vardelay; + long vardelay_n; + + double offset; + double vdscale; + long maxdelay; + long bufflen; + long index; + sample_type *buffer; +} tapf_susp_node, *tapf_susp_type; + + +void tapf_sn_fetch(register tapf_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 double offset_reg; + register double vdscale_reg; + register long maxdelay_reg; + register long bufflen_reg; + register long index_reg; + register sample_type * buffer_reg; + register sample_block_values_type vardelay_ptr_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tapf_sn_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the vardelay input sample block: */ + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + togo = min(togo, susp->vardelay_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; + offset_reg = susp->offset; + vdscale_reg = susp->vdscale; + maxdelay_reg = susp->maxdelay; + bufflen_reg = susp->bufflen; + index_reg = susp->index; + buffer_reg = susp->buffer; + vardelay_ptr_reg = susp->vardelay_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long phase; + phase = (long) (*vardelay_ptr_reg++ * vdscale_reg + offset_reg); + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay_reg) phase = maxdelay_reg; + phase = index_reg - phase; + /* now phase is a location in the buffer_reg (before modulo) */ + + /* Time out to update the buffer_reg: + * this is a tricky buffer_reg: buffer_reg[0] == buffer_reg[bufflen_reg] + * the logical length is bufflen_reg, but the actual length + * is bufflen_reg + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer_reg[index_reg++] = (s1_scale_reg * *s1_ptr_reg++); + if (index_reg >= bufflen_reg) { + index_reg = 0; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen_reg; + *out_ptr_reg++ = (sample_type) (buffer_reg[phase]);; + } while (--n); /* inner loop */ + + susp->bufflen = bufflen_reg; + susp->index = index_reg; + /* using vardelay_ptr_reg is a bad idea on RS/6000: */ + susp->vardelay_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(vardelay_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; + } +} /* tapf_sn_fetch */ + + +void tapf_si_fetch(register tapf_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type vardelay_x2_sample; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double offset_reg; + register double vdscale_reg; + register long maxdelay_reg; + register long bufflen_reg; + register long index_reg; + register sample_type * buffer_reg; + register double vardelay_pHaSe_iNcR_rEg = susp->vardelay_pHaSe_iNcR; + register double vardelay_pHaSe_ReG; + register sample_type vardelay_x1_sample_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tapf_si_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_samples(vardelay, vardelay_ptr, vardelay_cnt); + susp->vardelay_x1_sample = (susp->vardelay_cnt--, *(susp->vardelay_ptr)); + } + + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + vardelay_x2_sample = *(susp->vardelay_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 the s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + offset_reg = susp->offset; + vdscale_reg = susp->vdscale; + maxdelay_reg = susp->maxdelay; + bufflen_reg = susp->bufflen; + index_reg = susp->index; + buffer_reg = susp->buffer; + vardelay_pHaSe_ReG = susp->vardelay_pHaSe; + vardelay_x1_sample_reg = susp->vardelay_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long phase; + if (vardelay_pHaSe_ReG >= 1.0) { + vardelay_x1_sample_reg = vardelay_x2_sample; + /* pick up next sample as vardelay_x2_sample: */ + susp->vardelay_ptr++; + susp_took(vardelay_cnt, 1); + vardelay_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(vardelay, vardelay_ptr, vardelay_cnt, vardelay_x2_sample); + } + phase = (long) ( + (vardelay_x1_sample_reg * (1 - vardelay_pHaSe_ReG) + vardelay_x2_sample * vardelay_pHaSe_ReG) * vdscale_reg + offset_reg); + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay_reg) phase = maxdelay_reg; + phase = index_reg - phase; + /* now phase is a location in the buffer_reg (before modulo) */ + + /* Time out to update the buffer_reg: + * this is a tricky buffer_reg: buffer_reg[0] == buffer_reg[bufflen_reg] + * the logical length is bufflen_reg, but the actual length + * is bufflen_reg + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer_reg[index_reg++] = (s1_scale_reg * *s1_ptr_reg++); + if (index_reg >= bufflen_reg) { + index_reg = 0; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen_reg; + *out_ptr_reg++ = (sample_type) (buffer_reg[phase]);; + vardelay_pHaSe_ReG += vardelay_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->bufflen = bufflen_reg; + susp->index = index_reg; + susp->vardelay_pHaSe = vardelay_pHaSe_ReG; + susp->vardelay_x1_sample = vardelay_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* tapf_si_fetch */ + + +void tapf_sr_fetch(register tapf_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type vardelay_DeLtA; + sample_type vardelay_val; + sample_type vardelay_x2_sample; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double offset_reg; + register double vdscale_reg; + register long maxdelay_reg; + register long bufflen_reg; + register long index_reg; + register sample_type * buffer_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tapf_sr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->vardelay_pHaSe = 1.0; + } + + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + vardelay_x2_sample = *(susp->vardelay_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 the s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next vardelay_x2_sample when phase goes past 1.0; */ + /* we use vardelay_n (computed below) to avoid roundoff errors: */ + if (susp->vardelay_n <= 0) { + susp->vardelay_x1_sample = vardelay_x2_sample; + susp->vardelay_ptr++; + susp_took(vardelay_cnt, 1); + susp->vardelay_pHaSe -= 1.0; + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + vardelay_x2_sample = *(susp->vardelay_ptr); + /* vardelay_n gets number of samples before phase exceeds 1.0: */ + susp->vardelay_n = (long) ((1.0 - susp->vardelay_pHaSe) * + susp->output_per_vardelay); + } + togo = min(togo, susp->vardelay_n); + vardelay_DeLtA = (sample_type) ((vardelay_x2_sample - susp->vardelay_x1_sample) * susp->vardelay_pHaSe_iNcR); + vardelay_val = (sample_type) (susp->vardelay_x1_sample * (1.0 - susp->vardelay_pHaSe) + + vardelay_x2_sample * susp->vardelay_pHaSe); + + /* 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; + offset_reg = susp->offset; + vdscale_reg = susp->vdscale; + maxdelay_reg = susp->maxdelay; + bufflen_reg = susp->bufflen; + index_reg = susp->index; + buffer_reg = susp->buffer; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + long phase; + phase = (long) (vardelay_val * vdscale_reg + offset_reg); + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay_reg) phase = maxdelay_reg; + phase = index_reg - phase; + /* now phase is a location in the buffer_reg (before modulo) */ + + /* Time out to update the buffer_reg: + * this is a tricky buffer_reg: buffer_reg[0] == buffer_reg[bufflen_reg] + * the logical length is bufflen_reg, but the actual length + * is bufflen_reg + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer_reg[index_reg++] = (s1_scale_reg * *s1_ptr_reg++); + if (index_reg >= bufflen_reg) { + index_reg = 0; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen_reg; + *out_ptr_reg++ = (sample_type) (buffer_reg[phase]);; + vardelay_val += vardelay_DeLtA; + } while (--n); /* inner loop */ + + susp->bufflen = bufflen_reg; + susp->index = index_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->vardelay_pHaSe += togo * susp->vardelay_pHaSe_iNcR; + susp->vardelay_n -= 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; + } +} /* tapf_sr_fetch */ + + +void tapf_toss_fetch(susp, snd_list) + register tapf_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from vardelay up to final_time for this block of zeros */ + while ((round((final_time - susp->vardelay->t0) * susp->vardelay->sr)) >= + susp->vardelay->current) + susp_get_samples(vardelay, vardelay_ptr, vardelay_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->vardelay->t0) * susp->vardelay->sr - + (susp->vardelay->current - susp->vardelay_cnt)); + susp->vardelay_ptr += n; + susp_took(vardelay_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void tapf_mark(tapf_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->vardelay); +} + + +void tapf_free(tapf_susp_type susp) +{ + free(susp->buffer); + sound_unref(susp->s1); + sound_unref(susp->vardelay); + ffree_generic(susp, sizeof(tapf_susp_node), "tapf_free"); +} + + +void tapf_print_tree(tapf_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("vardelay:"); + sound_print_tree_1(susp->vardelay, n); +} + + +sound_type snd_make_tapf(sound_type s1, double offset, sound_type vardelay, double maxdelay) +{ + register tapf_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, vardelay->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, tapf_susp_node, "snd_make_tapf"); + susp->offset = offset * s1->sr; + susp->vdscale = vardelay->scale * s1->sr; + susp->maxdelay = (long)(maxdelay * s1->sr); + susp->bufflen = max(2, (long) (susp->maxdelay + 0.5)); + susp->index = susp->bufflen; + susp->buffer = (sample_type *) calloc(susp->bufflen + 1, sizeof(sample_type)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(vardelay, sr); + switch (interp_desc) { + case INTERP_ns: /* handled below */ + case INTERP_nn: /* handled below */ + case INTERP_ss: /* handled below */ + case INTERP_sn: susp->susp.fetch = tapf_sn_fetch; break; + case INTERP_ni: /* handled below */ + case INTERP_si: susp->susp.fetch = tapf_si_fetch; break; + case INTERP_nr: /* handled below */ + case INTERP_sr: susp->susp.fetch = tapf_sr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < vardelay->t0) sound_prepend_zeros(vardelay, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(vardelay->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 = tapf_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = tapf_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = tapf_mark; + susp->susp.print_tree = tapf_print_tree; + susp->susp.name = "tapf"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->vardelay = vardelay; + susp->vardelay_cnt = 0; + susp->vardelay_pHaSe = 0.0; + susp->vardelay_pHaSe_iNcR = vardelay->sr / sr; + susp->vardelay_n = 0; + susp->output_per_vardelay = sr / vardelay->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_tapf(sound_type s1, double offset, sound_type vardelay, double maxdelay) +{ + sound_type s1_copy = sound_copy(s1); + sound_type vardelay_copy = sound_copy(vardelay); + return snd_make_tapf(s1_copy, offset, vardelay_copy, maxdelay); +} diff --git a/tran/tapf.h b/tran/tapf.h new file mode 100644 index 0000000..879e0f1 --- /dev/null +++ b/tran/tapf.h @@ -0,0 +1,3 @@ +sound_type snd_make_tapf(sound_type s1, double offset, sound_type vardelay, double maxdelay); +sound_type snd_tapf(sound_type s1, double offset, sound_type vardelay, double maxdelay); + /* LISP: (snd-tapf SOUND ANYNUM SOUND ANYNUM) */ diff --git a/tran/tapv.alg b/tran/tapv.alg new file mode 100644 index 0000000..e71b3e5 --- /dev/null +++ b/tran/tapv.alg @@ -0,0 +1,53 @@ +(TAPV-ALG +(NAME "tapv") +(ARGUMENTS ("sound_type" "s1") ("double" "offset") ("sound_type" "vardelay") + ("double" "maxdelay")) +(INLINE-INTERPOLATION T) +(INTERNAL-SCALING vardelay) +(ALWAYS-SCALE s1) +(START (MAX s1 vardelay)) +(TERMINATE (MIN s1 vardelay)) +(LOGICAL-STOP (MIN s1)) +(STATE ("double" "offset" "offset * s1->sr") + ("double" "vdscale" "vardelay->scale * s1->sr") + ("double" "maxdelay" "maxdelay * s1->sr") + ("long" "bufflen" "max(2, (long) (susp->maxdelay + 1.5))") + ("long" "index" "susp->bufflen") + ("sample_type *" "buffer" + "(sample_type *) calloc(susp->bufflen + 1, sizeof(sample_type))")) +(SAMPLE-RATE (MAX s1)) +(CONSTANT "maxdelay" "offset" "vdscale" "buffer") +(INNER-LOOP-LOCALS " double phase; + long i; +") +(INNER-LOOP " phase = vardelay * vdscale + offset; + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay) phase = maxdelay; + phase = (double) index - phase; + /* now phase is a location in the buffer (before modulo) */ + + /* Time out to update the buffer: + * this is a tricky buffer: buffer[0] == buffer[bufflen] + * the logical length is bufflen, but the actual length + * is bufflen + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer[index++] = s1; + if (index > bufflen) { + buffer[0] = buffer[bufflen]; + index = 1; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen; + i = (long) phase; /* put integer part in i */ + phase -= (double) i; /* put fractional part in phase */ + output = (sample_type) (buffer[i] * (1.0 - phase) + + buffer[i + 1] * phase);") +(FINALIZATION " free(susp->buffer); +") +) + diff --git a/tran/tapv.c b/tran/tapv.c new file mode 100644 index 0000000..c7e555c --- /dev/null +++ b/tran/tapv.c @@ -0,0 +1,634 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "tapv.h" + +void tapv_free(); + + +typedef struct tapv_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type vardelay; + long vardelay_cnt; + sample_block_values_type vardelay_ptr; + + /* support for interpolation of vardelay */ + sample_type vardelay_x1_sample; + double vardelay_pHaSe; + double vardelay_pHaSe_iNcR; + + /* support for ramp between samples of vardelay */ + double output_per_vardelay; + long vardelay_n; + + double offset; + double vdscale; + double maxdelay; + long bufflen; + long index; + sample_type *buffer; +} tapv_susp_node, *tapv_susp_type; + + +void tapv_sn_fetch(register tapv_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 double offset_reg; + register double vdscale_reg; + register double maxdelay_reg; + register long bufflen_reg; + register long index_reg; + register sample_type * buffer_reg; + register sample_block_values_type vardelay_ptr_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tapv_sn_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the vardelay input sample block: */ + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + togo = min(togo, susp->vardelay_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; + offset_reg = susp->offset; + vdscale_reg = susp->vdscale; + maxdelay_reg = susp->maxdelay; + bufflen_reg = susp->bufflen; + index_reg = susp->index; + buffer_reg = susp->buffer; + vardelay_ptr_reg = susp->vardelay_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double phase; + long i; + phase = *vardelay_ptr_reg++ * vdscale_reg + offset_reg; + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay_reg) phase = maxdelay_reg; + phase = (double) index_reg - phase; + /* now phase is a location in the buffer_reg (before modulo) */ + + /* Time out to update the buffer_reg: + * this is a tricky buffer_reg: buffer_reg[0] == buffer_reg[bufflen_reg] + * the logical length is bufflen_reg, but the actual length + * is bufflen_reg + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer_reg[index_reg++] = (s1_scale_reg * *s1_ptr_reg++); + if (index_reg > bufflen_reg) { + buffer_reg[0] = buffer_reg[bufflen_reg]; + index_reg = 1; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen_reg; + i = (long) phase; /* put integer part in i */ + phase -= (double) i; /* put fractional part in phase */ + *out_ptr_reg++ = (sample_type) (buffer_reg[i] * (1.0 - phase) + + buffer_reg[i + 1] * phase);; + } while (--n); /* inner loop */ + + susp->bufflen = bufflen_reg; + susp->index = index_reg; + /* using vardelay_ptr_reg is a bad idea on RS/6000: */ + susp->vardelay_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(vardelay_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; + } +} /* tapv_sn_fetch */ + + +void tapv_si_fetch(register tapv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type vardelay_x2_sample; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double offset_reg; + register double vdscale_reg; + register double maxdelay_reg; + register long bufflen_reg; + register long index_reg; + register sample_type * buffer_reg; + register double vardelay_pHaSe_iNcR_rEg = susp->vardelay_pHaSe_iNcR; + register double vardelay_pHaSe_ReG; + register sample_type vardelay_x1_sample_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tapv_si_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_samples(vardelay, vardelay_ptr, vardelay_cnt); + susp->vardelay_x1_sample = (susp->vardelay_cnt--, *(susp->vardelay_ptr)); + } + + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + vardelay_x2_sample = *(susp->vardelay_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 the s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + offset_reg = susp->offset; + vdscale_reg = susp->vdscale; + maxdelay_reg = susp->maxdelay; + bufflen_reg = susp->bufflen; + index_reg = susp->index; + buffer_reg = susp->buffer; + vardelay_pHaSe_ReG = susp->vardelay_pHaSe; + vardelay_x1_sample_reg = susp->vardelay_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double phase; + long i; + if (vardelay_pHaSe_ReG >= 1.0) { + vardelay_x1_sample_reg = vardelay_x2_sample; + /* pick up next sample as vardelay_x2_sample: */ + susp->vardelay_ptr++; + susp_took(vardelay_cnt, 1); + vardelay_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(vardelay, vardelay_ptr, vardelay_cnt, vardelay_x2_sample); + } + phase = + (vardelay_x1_sample_reg * (1 - vardelay_pHaSe_ReG) + vardelay_x2_sample * vardelay_pHaSe_ReG) * vdscale_reg + offset_reg; + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay_reg) phase = maxdelay_reg; + phase = (double) index_reg - phase; + /* now phase is a location in the buffer_reg (before modulo) */ + + /* Time out to update the buffer_reg: + * this is a tricky buffer_reg: buffer_reg[0] == buffer_reg[bufflen_reg] + * the logical length is bufflen_reg, but the actual length + * is bufflen_reg + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer_reg[index_reg++] = (s1_scale_reg * *s1_ptr_reg++); + if (index_reg > bufflen_reg) { + buffer_reg[0] = buffer_reg[bufflen_reg]; + index_reg = 1; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen_reg; + i = (long) phase; /* put integer part in i */ + phase -= (double) i; /* put fractional part in phase */ + *out_ptr_reg++ = (sample_type) (buffer_reg[i] * (1.0 - phase) + + buffer_reg[i + 1] * phase);; + vardelay_pHaSe_ReG += vardelay_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->bufflen = bufflen_reg; + susp->index = index_reg; + susp->vardelay_pHaSe = vardelay_pHaSe_ReG; + susp->vardelay_x1_sample = vardelay_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* tapv_si_fetch */ + + +void tapv_sr_fetch(register tapv_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type vardelay_DeLtA; + sample_type vardelay_val; + sample_type vardelay_x2_sample; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double offset_reg; + register double vdscale_reg; + register double maxdelay_reg; + register long bufflen_reg; + register long index_reg; + register sample_type * buffer_reg; + register sample_type s1_scale_reg = susp->s1->scale; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tapv_sr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->vardelay_pHaSe = 1.0; + } + + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + vardelay_x2_sample = *(susp->vardelay_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 the s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next vardelay_x2_sample when phase goes past 1.0; */ + /* we use vardelay_n (computed below) to avoid roundoff errors: */ + if (susp->vardelay_n <= 0) { + susp->vardelay_x1_sample = vardelay_x2_sample; + susp->vardelay_ptr++; + susp_took(vardelay_cnt, 1); + susp->vardelay_pHaSe -= 1.0; + susp_check_term_samples(vardelay, vardelay_ptr, vardelay_cnt); + vardelay_x2_sample = *(susp->vardelay_ptr); + /* vardelay_n gets number of samples before phase exceeds 1.0: */ + susp->vardelay_n = (long) ((1.0 - susp->vardelay_pHaSe) * + susp->output_per_vardelay); + } + togo = min(togo, susp->vardelay_n); + vardelay_DeLtA = (sample_type) ((vardelay_x2_sample - susp->vardelay_x1_sample) * susp->vardelay_pHaSe_iNcR); + vardelay_val = (sample_type) (susp->vardelay_x1_sample * (1.0 - susp->vardelay_pHaSe) + + vardelay_x2_sample * susp->vardelay_pHaSe); + + /* 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; + offset_reg = susp->offset; + vdscale_reg = susp->vdscale; + maxdelay_reg = susp->maxdelay; + bufflen_reg = susp->bufflen; + index_reg = susp->index; + buffer_reg = susp->buffer; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + double phase; + long i; + phase = vardelay_val * vdscale_reg + offset_reg; + /* now phase should give number of samples of delay */ + if (phase < 0) phase = 0; + else if (phase > maxdelay_reg) phase = maxdelay_reg; + phase = (double) index_reg - phase; + /* now phase is a location in the buffer_reg (before modulo) */ + + /* Time out to update the buffer_reg: + * this is a tricky buffer_reg: buffer_reg[0] == buffer_reg[bufflen_reg] + * the logical length is bufflen_reg, but the actual length + * is bufflen_reg + 1 to allow for a repeated sample at the + * end. This allows for efficient interpolation. + */ + buffer_reg[index_reg++] = (s1_scale_reg * *s1_ptr_reg++); + if (index_reg > bufflen_reg) { + buffer_reg[0] = buffer_reg[bufflen_reg]; + index_reg = 1; + } + + /* back to the phase calculation: + * use conditional instead of modulo + */ + if (phase < 0) phase += bufflen_reg; + i = (long) phase; /* put integer part in i */ + phase -= (double) i; /* put fractional part in phase */ + *out_ptr_reg++ = (sample_type) (buffer_reg[i] * (1.0 - phase) + + buffer_reg[i + 1] * phase);; + vardelay_val += vardelay_DeLtA; + } while (--n); /* inner loop */ + + susp->bufflen = bufflen_reg; + susp->index = index_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->vardelay_pHaSe += togo * susp->vardelay_pHaSe_iNcR; + susp->vardelay_n -= 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; + } +} /* tapv_sr_fetch */ + + +void tapv_toss_fetch(susp, snd_list) + register tapv_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from vardelay up to final_time for this block of zeros */ + while ((round((final_time - susp->vardelay->t0) * susp->vardelay->sr)) >= + susp->vardelay->current) + susp_get_samples(vardelay, vardelay_ptr, vardelay_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->vardelay->t0) * susp->vardelay->sr - + (susp->vardelay->current - susp->vardelay_cnt)); + susp->vardelay_ptr += n; + susp_took(vardelay_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void tapv_mark(tapv_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->vardelay); +} + + +void tapv_free(tapv_susp_type susp) +{ + free(susp->buffer); + sound_unref(susp->s1); + sound_unref(susp->vardelay); + ffree_generic(susp, sizeof(tapv_susp_node), "tapv_free"); +} + + +void tapv_print_tree(tapv_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("vardelay:"); + sound_print_tree_1(susp->vardelay, n); +} + + +sound_type snd_make_tapv(sound_type s1, double offset, sound_type vardelay, double maxdelay) +{ + register tapv_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, vardelay->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, tapv_susp_node, "snd_make_tapv"); + susp->offset = offset * s1->sr; + susp->vdscale = vardelay->scale * s1->sr; + susp->maxdelay = maxdelay * s1->sr; + susp->bufflen = max(2, (long) (susp->maxdelay + 1.5)); + susp->index = susp->bufflen; + susp->buffer = (sample_type *) calloc(susp->bufflen + 1, sizeof(sample_type)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(vardelay, sr); + switch (interp_desc) { + case INTERP_ns: /* handled below */ + case INTERP_nn: /* handled below */ + case INTERP_ss: /* handled below */ + case INTERP_sn: susp->susp.fetch = tapv_sn_fetch; break; + case INTERP_ni: /* handled below */ + case INTERP_si: susp->susp.fetch = tapv_si_fetch; break; + case INTERP_nr: /* handled below */ + case INTERP_sr: susp->susp.fetch = tapv_sr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < vardelay->t0) sound_prepend_zeros(vardelay, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(vardelay->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 = tapv_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = tapv_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = tapv_mark; + susp->susp.print_tree = tapv_print_tree; + susp->susp.name = "tapv"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->vardelay = vardelay; + susp->vardelay_cnt = 0; + susp->vardelay_pHaSe = 0.0; + susp->vardelay_pHaSe_iNcR = vardelay->sr / sr; + susp->vardelay_n = 0; + susp->output_per_vardelay = sr / vardelay->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_tapv(sound_type s1, double offset, sound_type vardelay, double maxdelay) +{ + sound_type s1_copy = sound_copy(s1); + sound_type vardelay_copy = sound_copy(vardelay); + return snd_make_tapv(s1_copy, offset, vardelay_copy, maxdelay); +} diff --git a/tran/tapv.h b/tran/tapv.h new file mode 100644 index 0000000..81f4b83 --- /dev/null +++ b/tran/tapv.h @@ -0,0 +1,3 @@ +sound_type snd_make_tapv(sound_type s1, double offset, sound_type vardelay, double maxdelay); +sound_type snd_tapv(sound_type s1, double offset, sound_type vardelay, double maxdelay); + /* LISP: (snd-tapv SOUND ANYNUM SOUND ANYNUM) */ diff --git a/tran/tone.alg b/tran/tone.alg new file mode 100644 index 0000000..9a8e1a5 --- /dev/null +++ b/tran/tone.alg @@ -0,0 +1,15 @@ +(TONE-ALG +(NAME "tone") +(ARGUMENTS ("sound_type" "input") ("double" "hz")) +(START (MIN input)) +(TERMINATE (MIN input)) +(LOGICAL-STOP (MIN input)) +(STATE ("double" "b" "2.0 - cos(hz * PI2 / input->sr)" TEMP) + ("double" "c2" "b - sqrt((b * b) - 1.0)") + ("double" "c1" "(1.0 - susp->c2) * input->scale") + ("double" "prev" "0.0")) +(INTERNAL-SCALING input) +(CONSTANT "c1" "c2") +(INNER-LOOP "output = (sample_type) (prev = c1 * input + c2 * prev)") +) + diff --git a/tran/tone.c b/tran/tone.c new file mode 100644 index 0000000..a4c2e04 --- /dev/null +++ b/tran/tone.c @@ -0,0 +1,213 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "tone.h" + +void tone_free(); + + +typedef struct tone_susp_struct { + snd_susp_node susp; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + double c2; + double c1; + double prev; +} tone_susp_node, *tone_susp_type; + + +void tone_n_fetch(register tone_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 double c2_reg; + register double c1_reg; + register double prev_reg; + register sample_block_values_type input_ptr_reg; + falloc_sample_block(out, "tone_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + c2_reg = susp->c2; + c1_reg = susp->c1; + prev_reg = susp->prev; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) (prev_reg = c1_reg * *input_ptr_reg++ + c2_reg * prev_reg); + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* tone_n_fetch */ + + +void tone_toss_fetch(susp, snd_list) + register tone_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void tone_mark(tone_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void tone_free(tone_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(tone_susp_node), "tone_free"); +} + + +void tone_print_tree(tone_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_tone(sound_type input, double hz) +{ + register tone_susp_type susp; + double b; + rate_type sr = input->sr; + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, tone_susp_node, "snd_make_tone"); + b = 2.0 - cos(hz * PI2 / input->sr); + susp->c2 = b - sqrt((b * b) - 1.0); + susp->c1 = (1.0 - susp->c2) * input->scale; + susp->prev = 0.0; + susp->susp.fetch = tone_n_fetch; + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = tone_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = tone_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = tone_mark; + susp->susp.print_tree = tone_print_tree; + susp->susp.name = "tone"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_tone(sound_type input, double hz) +{ + sound_type input_copy = sound_copy(input); + return snd_make_tone(input_copy, hz); +} diff --git a/tran/tone.h b/tran/tone.h new file mode 100644 index 0000000..34798a1 --- /dev/null +++ b/tran/tone.h @@ -0,0 +1,3 @@ +sound_type snd_make_tone(sound_type input, double hz); +sound_type snd_tone(sound_type input, double hz); + /* LISP: (snd-tone SOUND ANYNUM) */ diff --git a/tran/tonev.alg b/tran/tonev.alg new file mode 100644 index 0000000..c7ba37e --- /dev/null +++ b/tran/tonev.alg @@ -0,0 +1,24 @@ +(TONEV-ALG +(NAME "tonev") +(ARGUMENTS ("sound_type" "s1") ("sound_type" "hz")) +(INLINE-INTERPOLATION T) +(INTERNAL-SCALING s1) +(ALWAYS-SCALE hz) +(START (MAX s1 hz)) +(TERMINATE (MIN s1 hz)) +(LOGICAL-STOP (MIN s1)) +(STATE ("double" "scale1" "s1->scale") + ("double" "c2" "0.0") + ("double" "c1" "0.0") + ("double" "prev" "0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr))")) +(SAMPLE-RATE (MAX s1)) +(STEP-FUNCTION hz) +(DEPENDS ("b" "hz" "2.0 - cos(hz)" TEMP "register double") + ("c2" "hz" "b - sqrt((b * b) - 1.0)") + ("c1" "hz" "(1.0 - c2) * scale1")) +(CONSTANT "c1" "c2" "b" "scale1") +(FORCE-INTO-REGISTER scale1) +(INNER-LOOP " output = (sample_type) (prev = c1 * s1 + c2 * prev)") +) + diff --git a/tran/tonev.c b/tran/tonev.c new file mode 100644 index 0000000..689d322 --- /dev/null +++ b/tran/tonev.c @@ -0,0 +1,531 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "tonev.h" + +void tonev_free(); + + +typedef struct tonev_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type s1; + long s1_cnt; + sample_block_values_type s1_ptr; + sound_type hz; + long hz_cnt; + sample_block_values_type hz_ptr; + + /* support for interpolation of hz */ + sample_type hz_x1_sample; + double hz_pHaSe; + double hz_pHaSe_iNcR; + + /* support for ramp between samples of hz */ + double output_per_hz; + long hz_n; + + double scale1; + double c2; + double c1; + double prev; +} tonev_susp_node, *tonev_susp_type; + + +void tonev_ns_fetch(register tonev_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 double scale1_reg; + register double c2_reg; + register double c1_reg; + register double prev_reg; + register sample_type hz_scale_reg = susp->hz->scale; + register sample_block_values_type hz_ptr_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tonev_ns_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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* don't run past the hz input sample block: */ + susp_check_term_samples(hz, hz_ptr, hz_cnt); + togo = min(togo, susp->hz_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; + scale1_reg = susp->scale1; + c2_reg = susp->c2; + c1_reg = susp->c1; + prev_reg = susp->prev; + hz_ptr_reg = susp->hz_ptr; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + register double b; + b = 2.0 - cos((hz_scale_reg * *hz_ptr_reg++)); + c2_reg = b - sqrt((b * b) - 1.0); + c1_reg = (1.0 - c2_reg) * scale1_reg; + *out_ptr_reg++ = (sample_type) (prev_reg = c1_reg * *s1_ptr_reg++ + c2_reg * prev_reg); + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* using hz_ptr_reg is a bad idea on RS/6000: */ + susp->hz_ptr += togo; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp_took(hz_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; + } +} /* tonev_ns_fetch */ + + +void tonev_ni_fetch(register tonev_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 double scale1_reg; + register double c2_reg; + register double c1_reg; + register double prev_reg; + register double hz_pHaSe_iNcR_rEg = susp->hz_pHaSe_iNcR; + register double hz_pHaSe_ReG; + register sample_type hz_x1_sample_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tonev_ni_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + register double b; + susp->started = true; + susp_check_term_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + b = 2.0 - cos(susp->hz_x1_sample); + susp->c2 = b - sqrt((b * b) - 1.0); + susp->c1 = (1.0 - susp->c2) * susp->scale1; + } + + 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 s1 input sample block: */ + susp_check_term_log_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; + } + + + /* 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; + scale1_reg = susp->scale1; + c2_reg = susp->c2; + c1_reg = susp->c1; + prev_reg = susp->prev; + hz_pHaSe_ReG = susp->hz_pHaSe; + hz_x1_sample_reg = susp->hz_x1_sample; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (hz_pHaSe_ReG >= 1.0) { +/* fixup-depends hz */ + register double b; + /* pick up next sample as hz_x1_sample: */ + susp->hz_ptr++; + susp_took(hz_cnt, 1); + hz_pHaSe_ReG -= 1.0; + susp_check_term_samples_break(hz, hz_ptr, hz_cnt, hz_x1_sample_reg); + hz_x1_sample_reg = susp_current_sample(hz, hz_ptr); + b = 2.0 - cos(hz_x1_sample_reg); + c2_reg = susp->c2 = b - sqrt((b * b) - 1.0); + c1_reg = susp->c1 = (1.0 - c2_reg) * scale1_reg; + } + *out_ptr_reg++ = (sample_type) (prev_reg = c1_reg * *s1_ptr_reg++ + c2_reg * prev_reg); + hz_pHaSe_ReG += hz_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->prev = prev_reg; + susp->hz_pHaSe = hz_pHaSe_ReG; + susp->hz_x1_sample = hz_x1_sample_reg; + /* using s1_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 */ + + /* 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; + } +} /* tonev_ni_fetch */ + + +void tonev_nr_fetch(register tonev_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type hz_val; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double scale1_reg; + register double c2_reg; + register double c1_reg; + register double prev_reg; + register sample_block_values_type s1_ptr_reg; + falloc_sample_block(out, "tonev_nr_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->hz_pHaSe = 1.0; + } + + susp_check_term_samples(hz, hz_ptr, hz_cnt); + + 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 s1 input sample block: */ + susp_check_term_log_samples(s1, s1_ptr, s1_cnt); + togo = min(togo, susp->s1_cnt); + + /* grab next hz_x1_sample when phase goes past 1.0; */ + /* use hz_n (computed below) to avoid roundoff errors: */ + if (susp->hz_n <= 0) { + register double b; + susp_check_term_samples(hz, hz_ptr, hz_cnt); + susp->hz_x1_sample = susp_fetch_sample(hz, hz_ptr, hz_cnt); + susp->hz_pHaSe -= 1.0; + /* hz_n gets number of samples before phase exceeds 1.0: */ + susp->hz_n = (long) ((1.0 - susp->hz_pHaSe) * + susp->output_per_hz); + b = 2.0 - cos(susp->hz_x1_sample); + susp->c2 = b - sqrt((b * b) - 1.0); + susp->c1 = (1.0 - susp->c2) * susp->scale1; + } + togo = min(togo, susp->hz_n); + hz_val = susp->hz_x1_sample; + /* 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; + scale1_reg = susp->scale1; + c2_reg = susp->c2; + c1_reg = susp->c1; + prev_reg = susp->prev; + s1_ptr_reg = susp->s1_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + *out_ptr_reg++ = (sample_type) (prev_reg = c1_reg * *s1_ptr_reg++ + c2_reg * prev_reg); + } while (--n); /* inner loop */ + + susp->prev = prev_reg; + /* using s1_ptr_reg is a bad idea on RS/6000: */ + susp->s1_ptr += togo; + out_ptr += togo; + susp_took(s1_cnt, togo); + susp->hz_pHaSe += togo * susp->hz_pHaSe_iNcR; + susp->hz_n -= 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; + } +} /* tonev_nr_fetch */ + + +void tonev_toss_fetch(susp, snd_list) + register tonev_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from s1 up to final_time for this block of zeros */ + while ((round((final_time - susp->s1->t0) * susp->s1->sr)) >= + susp->s1->current) + susp_get_samples(s1, s1_ptr, s1_cnt); + /* fetch samples from hz up to final_time for this block of zeros */ + while ((round((final_time - susp->hz->t0) * susp->hz->sr)) >= + susp->hz->current) + susp_get_samples(hz, hz_ptr, hz_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->s1->t0) * susp->s1->sr - + (susp->s1->current - susp->s1_cnt)); + susp->s1_ptr += n; + susp_took(s1_cnt, n); + n = round((final_time - susp->hz->t0) * susp->hz->sr - + (susp->hz->current - susp->hz_cnt)); + susp->hz_ptr += n; + susp_took(hz_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void tonev_mark(tonev_susp_type susp) +{ + sound_xlmark(susp->s1); + sound_xlmark(susp->hz); +} + + +void tonev_free(tonev_susp_type susp) +{ + sound_unref(susp->s1); + sound_unref(susp->hz); + ffree_generic(susp, sizeof(tonev_susp_node), "tonev_free"); +} + + +void tonev_print_tree(tonev_susp_type susp, int n) +{ + indent(n); + stdputstr("s1:"); + sound_print_tree_1(susp->s1, n); + + indent(n); + stdputstr("hz:"); + sound_print_tree_1(susp->hz, n); +} + + +sound_type snd_make_tonev(sound_type s1, sound_type hz) +{ + register tonev_susp_type susp; + rate_type sr = s1->sr; + time_type t0 = max(s1->t0, hz->t0); + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + falloc_generic(susp, tonev_susp_node, "snd_make_tonev"); + susp->scale1 = s1->scale; + susp->c2 = 0.0; + susp->c1 = 0.0; + susp->prev = 0.0; + hz->scale = (sample_type) (hz->scale * (PI2 / s1->sr)); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(s1, sr); + interp_desc = (interp_desc << 2) + interp_style(hz, sr); + switch (interp_desc) { + case INTERP_sn: /* handled below */ + case INTERP_ss: /* handled below */ + case INTERP_nn: /* handled below */ + case INTERP_ns: susp->susp.fetch = tonev_ns_fetch; break; + case INTERP_si: /* handled below */ + case INTERP_ni: susp->susp.fetch = tonev_ni_fetch; break; + case INTERP_sr: /* handled below */ + case INTERP_nr: susp->susp.fetch = tonev_nr_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < s1->t0) sound_prepend_zeros(s1, t0); + if (t0 < hz->t0) sound_prepend_zeros(hz, t0); + /* minimum start time over all inputs: */ + t0_min = min(s1->t0, min(hz->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 = tonev_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = tonev_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = tonev_mark; + susp->susp.print_tree = tonev_print_tree; + susp->susp.name = "tonev"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(s1); + susp->started = false; + susp->susp.current = 0; + susp->s1 = s1; + susp->s1_cnt = 0; + susp->hz = hz; + susp->hz_cnt = 0; + susp->hz_pHaSe = 0.0; + susp->hz_pHaSe_iNcR = hz->sr / sr; + susp->hz_n = 0; + susp->output_per_hz = sr / hz->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_tonev(sound_type s1, sound_type hz) +{ + sound_type s1_copy = sound_copy(s1); + sound_type hz_copy = sound_copy(hz); + return snd_make_tonev(s1_copy, hz_copy); +} diff --git a/tran/tonev.h b/tran/tonev.h new file mode 100644 index 0000000..95bc791 --- /dev/null +++ b/tran/tonev.h @@ -0,0 +1,3 @@ +sound_type snd_make_tonev(sound_type s1, sound_type hz); +sound_type snd_tonev(sound_type s1, sound_type hz); + /* LISP: (snd-tonev SOUND SOUND) */ diff --git a/tran/translate-stk.lsp b/tran/translate-stk.lsp new file mode 100644 index 0000000..15bf23a --- /dev/null +++ b/tran/translate-stk.lsp @@ -0,0 +1,13 @@ +(translate "stkrev") +(translate "stkpitshift") +(translate "stkchorus") +(translate "instrbow") +(translate "instrbowedfreq") +(translate "instrbanded") +(translate "instrmandolin") +(translate "instrsitar") +(translate "instrmodalbar") +(translate "instrflute") +(translate "instrflutefreq") +(translate "instrfluteall") + diff --git a/tran/translate.lsp b/tran/translate.lsp new file mode 100644 index 0000000..2fc81b7 --- /dev/null +++ b/tran/translate.lsp @@ -0,0 +1,1013 @@ +;************* +; Change Log +; Date | Change +;-----------+------------------------------------ +; 18-Dec-91 | [1.2] <jmn> Created +; 18-Dec-91 | [1.2] <jmn> added *ANSI* tests +; 13-Jan-92 | [1.2] <jmn> ANSI header includes stdlib.h, excludes decl of +; | malloc +; 13-Jan-92 | [1.2] <jmn> upgraded to support new sound block structure +; 15-Jan-92 | [1.2] <jmn> added declarations for UNKNOWN, isunknown() +; 15-Jan-92 | [1.2] <jmn> commented out boolean, true, false now declared +; | in sound.h +;************* +;; translate.lsp -- build signal processing code from high level descr. + +(setf *ANSI* t) +(setf *debug* t) + +;;********** +;; combinations - generate all combinations +;; Inputs: +;; n - number of combinations to generate +;; Result: +;; list of the form +;; ( (a1 b1) (a2 b2) (a3 b3) ... (an bn) ) +;; +;;********** + +(defun combinations (n) + (let (comb) + (cond ((eq n 0) '(nil)) + (t + (setf comb (combinations (1- n))) + (append (insert 'ramp comb) + (insert 'interp comb) + (insert 'scale comb) + (insert 'none comb)))))) + +(print 'comb) + +(defun lt () (load "translate")) +(defun ls () (load "writesusp")) +(defun lm () (load "writemake")) +(defun lo () (load "writetoss")) +(defun li () (load "innerloop")) + +(defun ma () (translate "partial")) +(defun mb () (translate "buzz")) +(defun mal () (translate "alpass")) +(defun macv () (translate "alpasscv")) +(defun mavv () (translate "alpassvv")) +(defun mf () (translate "follow")) +(defun mfas () (translate "fromarraystream")) +(defun mfo () (translate "fromobject")) +(defun mp () (translate "prod")) +(defun mc () (translate "const")) +(defun mct () (translate "coterm")) +(defun mcl () (translate "clip")) +(defun meqb () (translate "eqbandvvv")) +(defun me () (translate "exp")) +(defun mg () (translate "gate")) +;(defun mr () (translate "ramp")) +(defun ms () (translate "sine")) +(defun msh () (translate "shape")) +(defun mpw () (translate "pwl")) +;(defun msfr () (translate "sfread")) +(defun mde () (translate "delaycc")) +(defun mdcv () (translate "delaycv")) +; note: downproto is hand retouched to make downsample +;(defun md () (translate "downproto")) +(defun mu () (translate "upsample")) +(defun ml () (translate "scale")) +(defun mlo () (translate "log")) +(defun mm () (translate "maxv")) +(defun mo () (translate "osc")) +(defun mof () (translate "offset")) +(defun mam () (translate "amosc")) +(defun mfm () (translate "fmosc")) +(defun mi () (translate "integrate")) +(defun msl () (translate "slope")) +(defun mw () (translate "white")) +(defun mt () (translate "tone")) +(defun mta () (translate "tapv")) +(defun mtf () (translate "tapf")) +(defun mat () (translate "atone")) +(defun mre () (translate "reson")) +(defun mrec () (translate "recip")) +(defun mar () (translate "areson")) +(defun mtv () (translate "tonev")) +(defun matv () (translate "atonev")) +(defun mrvc () (translate "resonvc")) +(defun mrcv () (translate "resoncv")) +(defun marvc () (translate "aresonvc")) +(defun marcv () (translate "aresoncv")) +(defun mrvv () (translate "resonvv")) +(defun marvv () (translate "aresonvv")) +(defun msa () (translate "sampler")) +(defun msio () (translate "siosc")) +(defun mq () (translate "quantize")) +(defun mbq () (translate "biquadfilt")) +(defun mabs () (translate "abs")) +(defun msqrt () (translate "sqrt")) + +(defun mifft () (translate "ifft")) + +(defun mcg () (translate "congen")) +(defun mcv () (translate "convolve")) ;; this does not generate the final version + ;; see the hand-modified version of convolve.c in nyqsrc directory +(defun mos () (translate "oneshot")) +(defun mch () (translate "chase")) +(defun mpl () (translate "pluck")) +(defun icl () (translate "instrclar")) +(defun isx () (translate "instrsax")) +(defun icla () (translate "instrclarall")) +(defun isxa () (translate "instrsaxall")) +(defun iclf () (translate "instrclarfreq")) +(defun isxf () (translate "instrsaxfreq")) +(defun mla () (translate "allpoles")) +(defun mlr () (translate "lpreson")) + +(defun mstk () (icl) (isx) (icla) (isxa) (iclf) (isxf)) +(defun mfmfb () (translate "fmfb") (translate "fmfbv")) + +(defun m () (mf) (mp) (mc) (mcl) (mg) +;;;;;; (mr) (msfr) (md) + (mm) (ms) (msh) (mpw) (ma) (mb) (mde) (mdcv) + (mi) (mu) (ml) (mlo) + (mo) (mof) (mam) (mfm) (mw) (msl) (mt) (mat) (mre) (mrec) + (mar) (mtv) (mta) (mtf) (matv) (mrvc) (mrcv) (marvc) (marcv) + (mrvv) (marvv) (me) (msa) (msio) (mq) (mcg) (mifft) + (mfas) (mfo) (mct) (mal) (mos) (mch) (mbq) (mpl) + (mabs) (msqrt) (macv) (mavv) ; (mcv) must be managed by hand + (mstk) (mla) (mlr) (load "translate-stk") (mfmfb)) + +; call this when you change writesusp.lsp: "N"ew "S"usp +(defun ns () (ls) (m)) +; call this when you change writemake.lsp: +(defun nm () (lm) (m)) +; call this when you change innerloop.lsp: +(defun ni () (li) (m)) + + +;;********** +;; any-ramp-in -- see if interpolation-list has 'ramp +;; +;; note: lis is a list of lists of atoms +;;********** +(defun any-ramp-in (lis) + (dolist (spec lis) + (cond ((member 'RAMP spec) + (return t))))) + + +;;********** +;; any-ramp-or-interp-in -- see if interpolation-list has 'ramp or 'interp +;; +;;********** +(defun any-ramp-or-interp-in (lis) + (or (any-ramp-in lis) + (dolist (spec lis) + (cond ((member 'INTERP spec) + (return t)))))) + + +;;********** +;; encode -- come up with ascii string for interp spec +;; +;; e.g. (none ramp) -> "nr" +;; +;;********** +(defun encode (interpolation) + (let (first-letter + (result "")) + (dolist (interp interpolation) + (setf first-letter (string (char (symbol-name interp) 0))) + (setf result (strcat result first-letter))) + (string-downcase result))) + + +;; **************** +;; header-list +;; +;; Result: +;; '( "s1" "s2" ... "sn" ) +;; where s1, s2, etc. are the strings for the header part of the +;; resulting .c file +;; Notes: +;; Kludgy. Fix this up for easier maintenance +;; **************** + +(if *ANSI* + ; ANSI + (setf header-list + '("#include \"stdio.h\"\n" + "#ifndef mips\n" + "#include \"stdlib.h\"\n" + "#endif\n" + "#include \"xlisp.h\"\n" + "#include \"sound.h\"\n\n" + "#include \"falloc.h\"\n" + "#include \"cext.h\"\n" + )) + ; non-ANSI + (setf header-list + '("#include \"stdio.h\"\n" + "#include \"xlisp.h\"\n" + "#include \"sound.h\"\n" + "#include \"falloc.h\"\n"))) + + +(setf h-boilerplate nil) + +;--------------obsolete boilerplate------------- +;; Note that we use "-1" and "< 0". We rely upon C's semantics to +;; make this work correctly if it is being assigned to a long, float, or +;; double, and if a long, float, or double is being compared +; '("\n#ifndef UNKNOWN\n" +; "#define UNKNOWN -1\n" +; "#define isunknown(x) ( (x) < 0)\n" +; "#endif /* UNKNOWN */\n")) +;------------------------- + + +;;********** +;; code-gen -- do the output +;; +;; Inputs: +;; alg - +;; stream - +;; hstream - +;;********** + +(defun code-gen (alg stream hstream) + (let (interpolation-list + (support-functions (get-slot alg 'support-functions)) + (support-header (get-slot alg 'support-header)) + (name (get-slot alg 'name))) + ;(display "code-gen: " alg stream hstream) + (print-strings header-list stream) + (format stream "#include \"~A\"~%" (get-slot alg 'hfile)) + (display "code-gen: printed header") + (format stream "~%void ~A_free();~%" name) + (setf interpolation-list (make-interpolation-list alg)) + (display "code-gen: " interpolation-list) + (put-slot alg interpolation-list 'interpolation-list) + (put-slot alg (make-interpolation-rationale alg) + 'interpolation-rationale) + + (write-typedef alg stream) + (display "code-gen: wrote typedef") + + (cond (support-functions + (format stream "~%~A" support-functions))) + + (dolist (interpolation interpolation-list) + (put-slot alg interpolation 'interpolation) + (display "code-gen: going to write susp for " interpolation) + (write-susp alg stream) + (display "code-gen: wrote susp for" interpolation)) + + ;; this is a special case for no sound arguments + (cond ((null interpolation-list) + (write-susp alg stream))) + + ;; write the function that is called to read and toss + ;; samples up to the start time (but only if there are sound arguments) + (cond ((get-slot alg 'sound-names) + (write-toss alg stream))) + + ;; write the GC marking function + (cond ((needs-mark-routine alg) + (write-mark alg stream))) + + (write-make alg stream) + (display "code-gen: wrote make") + + (write-xlmake alg stream) + (display "code-gen: wrote xlmake") + + (write-header alg hstream) + (cond ( support-header + (print-strings support-header hstream))) + (print-strings h-boilerplate hstream) + (display "code-gen: wrote header"))) + + +;;********** +;; commute-check -- +;; +;; Purpose: +;; see if interpolation spec is redundant due to commutativity +;; Algorithm: +;; for each list of "commutable" sounds, make sure spec asks for +;; cannonical ordering: NONE > SCALE > INTERP > RAMP +;;********** +(defun commute-check (alg spec) + (let ((sounds (get-slot alg 'sound-args)) + (commute-list (get-slot alg 'commutative)) + (result t) + s1 s2) + (dolist (commute commute-list) + (dotimes (n (1- (length commute))) ; look at all pairs + (setf s1 (nth n commute)) + (setf s2 (nth (1+ n) commute)) + (setf s1 (index s1 sounds)) + (setf s2 (index s2 sounds)) + (setf s1 (nth s1 spec)) + (setf s2 (nth s2 spec)) + (cond ((< (eval s1) (eval s2)) + (setf result nil) + (return))))) + result)) + +(setf NONE 4) (setf SCALE 3) (setf INTERP 2) (setf RAMP 1) + + +(print 'ramp) + + +;;********** +;; concatenate -- string concatenation +;; +;; Inputs: +;; "s1" - string +;; "s2" - string +;; Result: +;; "s1s2" +;;********** + +(defun concatenate (type s1 s2) + (cond ((eq type 'string) (strcat s1 s2)) + (t (error "concatenate type")))) + + +;;********** +;; get-slot -- access the algorithm description, return single value +;; +;;********** + +(setfn get-slot get) + + +;;********** +;; index -- find location of list element +;; +;; Inputs: +;; atom - atom to be found in list +;; lis - list searched for +;; Result: +;; integer - index of atom in lis +;; NIL - atom not member of lis +;;********** + +(defun index (atom lis) + (let ((i 0)) + (dolist (elt lis) + (cond ((eq elt atom) + (return i))) + (setf i (1+ i))))) + + +;;********** +;; insert -- insert an atom at the front of each element of a list +;; +;; Inputs: +;; atom - +;; list-of-lists - lists of the form ( (L1) (L2) ... (Ln)) +;; Result: +;; ( (atom L1) (atom L2) ... (atom Ln) ) +;;********** +(defun insert (atom list-of-lists) + (mapcar '(lambda (lis) (cons atom lis)) list-of-lists)) + +(print 'insert) + +;; interp-check -- check to see that no interpolation is being done +;; (unless the algorithm is the up-sample algorithm, a special case +;; +(defun interp-check (alg spec) + (or *INLINE-INTERPOLATION* + (get alg 'inline-interpolation) + (and (not (member 'INTERP spec)) + (not (member 'RAMP spec))))) + +(print 'interp-check) + + +;;********** +;; make-interpolation-list -- figure out the possible interpolation forms +;; +;; Inputs: +;; alg - algorithm description +;; Output: +;; List of interpolation styles, e.g. +;; ((NONE NONE) (NONE INTERP) (NONE RAMP)), where the styles +;; are in the same order as the sound arguments (sound-args) +;; +;;********** +(defun make-interpolation-list (alg) + (let (sound-args specs real-specs sound-names sound-to-name + (sr (get-slot alg 'sample-rate)) + (not-in-inner-loop (get-slot alg 'not-in-inner-loop))) + ; derive some lists: + ; sound-args are atom names of sound-type arguments + ; sound-names are the corresponding string names + ; sound-to-name is an assoc list mapping atom to case-sensitive string +; (display "make-interpolation-list") + + (dolist (arg (get-slot alg 'arguments)) + (cond ((and (equal (car arg) "sound_type") + (not (member (cadr arg) not-in-inner-loop :test #'equal))) + (setf sound-names (cons (cadr arg) sound-names)) + (setf sound-args (cons (name-to-symbol (cadr arg)) + sound-args)) + (setf sound-to-name (cons (cons (car sound-args) + (car sound-names)) + sound-to-name)) +; (display "in make-interpolation-list" sound-to-name) + ))) +; (display "make-interpolation-list: " (reverse sound-args)) + (put-slot alg (reverse sound-args) 'sound-args) +; (display "make-interpolation-list: " (reverse sound-names)) + (put-slot alg (reverse sound-names) 'sound-names) + (put-slot alg sound-to-name 'sound-to-name) + ; make all combinations of interpolations + (setf specs (combinations (length sound-args))) + ;; don't print this or you'll die when the list is huge + ;; (display "make-interpolation-list: " specs) + ;; we really should have filtered with match-check inside combinations + ;; to avoid exponential explosion + ; reject combinations based on commutativity, linearity, and sample rate: + ; if sample-rate is not specified, then some interpolation must be 'NONE, + ; i.e. sample-rate is specified OR an interpolation is 'NONE: + ; if INLINE-INTERPOLATION is turned off, don't allow RAMP or INTERP + ; if INTERNAL-SCALING applies, then don't allow SCALE + (dolist (spec specs) + (cond ((and spec + (interp-check alg spec) + (commute-check alg spec) + (scale-check alg spec) + (match-check alg spec) + (sr-check alg spec)) + (setf real-specs (cons spec real-specs))))) + (cond ((and (car specs) (null real-specs)) + (error "no interpolation specs"))) + (print real-specs))) + + +; MAKE-INTERPOLATION-RATIONALE -- record the rationale for +; interpolation combinations: +; NIL means no special considerations +; ALWAYS-SCALE means 'n' eliminated, use 's' instead +; LINEAR means 's' eliminated and unnecessary +; INTERNAL-SCALING means 's' eliminated, use 'n' instead +; +(defun make-interpolation-rationale (alg) + (let (interpolation-rationale len snd + (sounds (get-slot alg 'sound-args)) + (linear (get-slot alg 'linear)) + (internal-scaling (get-slot alg 'internal-scaling)) + (always-scale (get-slot alg 'always-scale))) + (setf interpolation-rationale (mapcar #'return-nil sounds)) + (setf len (length interpolation-rationale)) + (dotimes (n len) + (setf snd (nth n sounds)) + (cond ((member snd always-scale) + (setf (nth n interpolation-rationale) 'ALWAYS-SCALE))) + (cond ((member snd linear) + (cond ((nth n interpolation-rationale) + (error "parameter is both linear and always-scale" + snd))) + (setf (nth n interpolation-rationale) 'LINEAR))) + (cond ((member snd internal-scaling) + (cond ((nth n interpolation-rationale) + (error + "parameter is both linear and always-scale or internal-scaling" snd))) + (setf (nth n interpolation-rationale) 'INTERNAL-SCALING)))) + (display "make-interpolation-rationale" interpolation-rationale) + interpolation-rationale)) + + +(print 'hi) + +;;********** +;; make-schema-from-slots -- take attr/value pairs and make property list +;; +;; Inputs: +;; slots - a list of the form +;; (name +;; (attribute1 value1) (attribute2 value2) +;; ... (attributen valuen) ) +;; Result: +;; The atom 'name' with the attached property list +;; Effect: +;; Adds properties to the atom 'name' based on the attribute-value +;; pairs. +;; Notes: +;; The property-list representation is chosen for time efficiency of +;; access +;;********** + +(defun make-schema-from-slots (slots) + (let ((name (car slots))) + (setf (symbol-plist name) nil) + (dolist (slot (cdr slots)) + (putprop name (cdr slot) (car slot))) + name)) + +;;**************** +;; name-to-symbol -- convert from case-sensitive C name to internal symbol +;;**************** +(defun name-to-symbol (name) (intern (string-upcase name))) + + + +;;********** +;; position -- find a pattern in a string +;; +;; Inputs: +;; s - +;; p - +;;********** + +(defun position (s p) + (let (result (len (length p))) + (dotimes (n (+ 1 (length s) (- len))) + (cond ((equal (subseq s n (+ n len)) p) + (setf result n) + (return)))) + result)) + + +;;********** +;; print a list of strings to a stream +;; +;; Inputs: +;; strings - a list of strings +;; stream - stream on which to write the strings +;; Effect: +;; +;;********** + +(defun print-strings (strings stream) + (dolist (s strings) (princ s stream))) + + + +;;********** +;; put-slot: +;; +;; Inputs: +;; schema - name of the schema +;; value - value of the attribute to be added or modified +;; property - name of the attribute to be modified +;; +;;********** + +(setfn put-slot putprop) + + +(defun return-nil (ignore) nil) + +;;********** +;; scale-check -- make sure scale method is not used on linear input or +;; on input where scaling is factored into other computation; +;; Also, don't use NONE scale method if sound appears on always-scale +;; list (these sounds have low likelihood of ever using 'NONE method - +;; see fmosc for an example). Note that if you say always-scale (removing +;; NONE) and linear or internal-scaling (removing SCALE), +;; then you'll be in big trouble. +;; +;; Inputs: +;; alg - algorithm description +;; spec - +;; Notes: +;; +;;********** + +(defun scale-check (alg spec) + (let ((sounds (get-slot alg 'sound-args)) + (linear (get-slot alg 'linear)) + (internal-scaling (get-slot alg 'internal-scaling)) + (always-scale (get-slot alg 'always-scale)) + snd + (result t) + ) + ; initially, the rationale list is nil for each sound: + (cond (always-scale + (dotimes (n (length spec)) ; look at each method in spec + (cond ((eq 'NONE (nth n spec)) + (setf snd (nth n sounds)) + (cond ((member snd always-scale) + (setf result nil) + (return)))))))) + (cond ((member 'SCALE spec) ; quick test + (dotimes (n (length spec)) ; look at each method in spec + (cond ((eq 'SCALE (nth n spec)) + (setf snd (nth n sounds)) + (cond ((or (member snd linear) + (member snd internal-scaling)) + (if (member snd internal-scaling) + (format t "WARNING internal scaling not fully debugged, check your results...\n")) + (setf result nil) + (return)))))))) + result)) + + +;; match-check -- make sure spec is consistent with inputs whose sample-rates +;; are matched. If a set of inputs appears on a MATCHED-SAMPLE-RATE clause, +;; then the spec for each input must be the same. This is used to control +;; combinatorial explosions. +;; +(defun match-check (alg spec) + (let ((sounds (get-slot alg 'sound-args)) + (matched-sample-rate (get-slot alg 'matched-sample-rate)) + kind ;; kind of access used by all matched sounds + snd ;; the current sound in list + (result t)) + ;; algorithm: scan list for members of matched-sample-rate + ;; when first is found, set kind; after than, insist that + ;; other members have matching spec + (cond (matched-sample-rate + (dotimes (n (length spec)) + (setf snd (nth n sounds)) + (cond ((member snd matched-sample-rate) + (cond ((null kind) + (setf kind (nth n spec))) + ((eq (nth n spec) kind)) + (t + (setf result nil)))))))) + result)) + + +;;**************** +;; space-if-no-trailing-star -- returns "" if arg ends with "*", else space +;;**************** +(defun space-if-no-trailing-star (str) + (if (equal #\* (char str (1- (length str)))) + "" + #\Space)) + + +;; SPEC-IS-NONE-OR-SCALE -- see if spec is none or scale, called by sr-check +;; +;; sig is the search key +;; sound-args is a list, one element matches sig +;; spec is list of specs corresponding to elements in sound-args +;; return t if (eq sig (nth n sound-args)) and (nth n spec) is +;; either 'none or 'scale +;; +(defun spec-is-none-or-scale (sig sound-args spec) + (dolist (arg sound-args) + (cond ((eq sig arg) + (return (member (car spec) '(NONE SCALE))))) + (setf spec (cdr spec)))) + + +;;**************** +;; sr-check -- see if interpolation spec is ok wrt sample rate spec +;;**************** +(defun sr-check (alg spec) + (let ((sample-rate (get-slot alg 'sample-rate)) + (sound-args (get-slot alg 'sound-args)) + (result t)) + ;; if expression given, then anything is ok + (cond ((stringp sample-rate) t) + ;; if (MAX ...) expression given, then one of signals must be NONE or SCALE + ((and (listp sample-rate) (eq (car sample-rate) 'MAX)) + (dolist (sig (cdr sample-rate)) ; for all sig in max list ... + (cond ((not (spec-is-none-or-scale sig sound-args spec)) + (setf result nil)))) + result) + ;; if no expression given, then one signal must be NONE or SCALE + ((or (member 'NONE spec) (member 'SCALE spec)) t) + ;; o.w. return false + (t nil)))) + + +;;**************** +;; symbol-to-name -- convert from internal symbol to case-sensitive C name +;;**************** +(defun symbol-to-name (symbol) (get symbol 'string-name)) + + + +;;********** +;; translate -- main procedure +;; +;; Inputs: +;; name - string which is name of file to translate +;; Effect: +;; Reads the algorithm specification as "name.alg" +;; Generates output files "name.c" and "name.h" +;;********** +(defun translate (name) + (prog* ((infile (concatenate 'string name ".alg")) + (outfile (concatenate 'string name ".c")) + (hfile (concatenate 'string name ".h")) + (inf (open infile :direction :input)) + (hf (open hfile :direction :output)) + (outf (open outfile :direction :output))) + + (if (null inf) (error "translate: couldn't open inf")) + (if (null hf) (error "translate: couldn't open hf")) + (if (null outf) (error "translate: couldn't open outf")) + + (display "FILES" inf hf outf) + + (if *WATCH* + (print "**** TRACING HOOKS ENABLED! ****") + (print "**** NO TRACING ****") + ) + loop + ;; read the algorithm description + (setq alg (read inf)) + + ;; if the algorithm is NIL, we had some sort of failure + (cond ((null alg) + (close inf) + (close hf) + (close outf) + (return))) + + ;; we have read in the high-level schema specification + ;; convert it to a schema + (display "translate: " infile alg) + (setf alg (make-schema-from-slots alg)) + (display "translate: schema " alg) + + ;; save the .h file name + (put-slot alg hfile 'hfile) + ;; perform the type-check on the schema parameters + (type-check-and-transform alg) + (display "translate: transformed schema" alg) + (code-gen alg outf hf) + (display "translate: finished code-gen") + (setf save-alg alg) + (go loop) + ) +) + + +(print 'translate) + +;;********** +;; type-check-and-transform -- fix up slots in an algorithm schema +;; +;; Inputs: +;; alg - the name of the algorithm; values are its property list +;; Notes: +;; Report an error if required slot values are absent +;; Any slot which should be a single value and is a list is +;; coerced to be the car of the list +;; Put argument string names on argument symbols for conversion. +;;********** + +(defun type-check-and-transform (alg) + + ;; the quoted list that follows 'slot' is the list of required + ;; parameters. If any parameter is missing, this will cause an + ;; error + + (dolist (slot '(name inner-loop)) ; other necessarily non-nil slots go here + (cond ((null (get-slot alg slot)) + (error "missing slot")))) + + ; fix single-value slots to not be stored as lists: + ; If the value is a list, the value is coerced to + ; be the car of the list + + (dolist + (slot + '(name lispname inner-loop sample-rate support-functions inline-interpolation delay + )) + (put-slot alg (car (get-slot alg slot)) slot)) + + ; Make sure there are no strings, only symbols, in TERMINATE and + ; LOGICAL-STOP MIN lists: (TERMINATE (MIN "s1")) is wrong, it should be + ; (TERMINATE (MIN s1)) + + (dolist (field '(terminate logical-stop)) + (setf spec (get-slot alg field)) + (display "type-check" spec field) + (cond ((and spec + (listp (car spec)) + (member (caar spec) '(MIN MAX))) + (dolist (entry (cdar spec)) + (display "type-check" spec field entry) + (cond ((eq (type-of entry) 'STRING) + (error "MIN and MAX args are symbols, not strings" + spec))))))) + + ; (ARGUMENTS ( "type1" "name1") ("type2" "name2") ... ("typen" "namen") ) + ; if "sr" is the name of an argument, its type must be "rate_type" + ; i.e. ("rate_type" "sr") + + (dolist (arg (get-slot alg 'arguments)) + (cond ((and (equal (cadr arg) "sr") + (not (equal (car arg) "rate_type"))) + (error "argument sr must be of type rate_type")) + ((equal (car arg) "sound_type") + (putprop (name-to-symbol (cadr arg)) (cadr arg) 'string-name))))) + + + +;;********** +;; union-of-nth -- get the union of the nth element of each sublist +;; +;;********** +(defun union-of-nth (lis n) + (let (result a) + (dolist (sublis lis) + (setf a (nth n sublis)) + (cond ((not (member a result)) + (setf result (cons a result))))) + result)) + + +(print 'union-of-nth) + +;;********** +;; write-header -- write a header file for the suspension create routine +;; +;; Inputs: +;; alg - algorithm name +;; stream - output stream for .h file +;; Effect: +;; Writes to the stream +;; sound_type snd_make_NAME(); +;; Notes: +;; Uses NAME property of algorithm to emit the procedure header to +;; the .h file +;;********** + +(setf c-to-xlisp-type '( + ("double" . "ANYNUM") + ("float" . "ANYNUM") + ("time_type" . "ANYNUM") + ("rate_type" . "ANYNUM") + ("sample_type" . "ANYNUM") + ("sound_type" . "SOUND") + ("char *" . "STRING") + ("LVAL" . "ANY") + ("int" . "FIXNUM") + ("long" . "FIXNUM") + ("boolean" . "BOOLEAN") +)) + + +(defun write-header (alg stream) +;; (format stream "sound_type snd_make_~A();~%" (get-slot alg 'name)) + (let ((arguments (get-slot alg 'arguments)) + (name (get-slot alg 'name)) + (lisp-name (get-slot alg 'lispname))) + (cond ((null lisp-name) (setf lisp-name name))) + (format stream "sound_type snd_make_~A" name) + (write-ansi-prototype-list stream "" arguments) + (format stream ";~%") + + ; write the xlisp interface routine + (format stream "sound_type snd_~A" name) + (write-ansi-prototype-list stream "" arguments) + (format stream ";~%") + + ; write the type specification for intgen + (format stream " /* LISP: (snd-~A" lisp-name) + (dolist (arg arguments) + (let ((xltype (assoc (car arg) c-to-xlisp-type :test #'equal))) + (cond ((null xltype) + (error "couldn't translate c-type" (car arg)))) + (format stream " ~A" (cdr xltype)))) + (format stream ") */~%"))) + + +;;********** +;; write-typedef -- compile the suspension type definition +;; +;; Inputs: +;; alg - the algorithm specification +;; stream - stream to which to write it +;; Effect: +;; typedef struct NAME_susp_struct { +;; ... +;; } NAME_susp_node, *NAME_susp_type; +;; +;; A side-effect of write-typedef is the initialization +;; of slot xlisp-pointers in alg. This is used later by +;; write-mark to generate the garbage collection mark routine. +;;********** + +(defun write-typedef (alg stream) + (let (arg-type args interpolation-list sound-names arg + (alg-name (get-slot alg 'name)) + name xlisp-pointers + (state-list (get-slot alg 'state)) + (logical-stop (car (get-slot alg 'logical-stop))) + (terminate (car (get-slot alg 'terminate)))) + ;---------------------------- + ; typedef struct NAME_susp_strct { + ; snd_susp_node susp; + ;---------------------------- + (format stream "~%~%typedef struct ~A_susp_struct {~%~A~%" + alg-name " snd_susp_node susp;") + + ; go through interpolation list: + ; NONE means use each sample + ; INTERP means interpolate between samples + ; RAMP means do ramp generation between samples + ; NIL means this is not a signal + + (setf interpolation-list (get-slot alg 'interpolation-list)) + (setf sound-names (get-slot alg 'sound-names)) + + ; declare started flag if there is a ramp or interp signal anywhere + (cond ((any-ramp-or-interp-in interpolation-list) + ;--------------------- + ; INTERP/RAMP: + ; boolean started; + ;--------------------- + (format stream " boolean started;~%"))) + + (display "in translate.lsp" + terminate alg (terminate-check-needed terminate alg)) + (cond ((terminate-check-needed terminate alg) + ;---------------- + ; long terminate_cnt; + ;---------------- + (format stream " long terminate_cnt;~%"))) + + (cond ((logical-stop-check-needed logical-stop) + ;---------------- + ; boolean logically_stopped; + ;---------------- + (format stream + " boolean logically_stopped;~%"))) + + ; each sound argument has a variety of ways it might be + ; interpolated. These are stored on interpolation-list, and union-of-nth + ; is used to gather all the interpolation styles that must be supported + ; for a given signal - we then declare whatever state is necessary for + ; each possible interpolation + (dotimes (n (length (get alg 'sound-args))) + (let ((interpolation (union-of-nth interpolation-list n))) + (setf name (nth n sound-names)) ; get name of signal + ;------------------------ + ; sound_type NAMEi; + ; long NAME_cnt; + ; sample_block_values_type NAME_ptr; + ;------------------------ + (format stream " sound_type ~A;~%" name) + (format stream " long ~A_cnt;~%" name) + (format stream " sample_block_values_type ~A_ptr;~%" name) + (cond ((or (member 'INTERP interpolation) + (member 'RAMP interpolation)) + ;----------------- + ; /* support for interpolation of NAMEi */ + ;----------------- + (format stream + "~% /* support for interpolation of ~A */~%" name) + + ;----------------- + ; sample_type NAME_x1_sample; + ;----------------- + (format stream " sample_type ~A_x1_sample;~%" name) + + ;----------------- + ; double NAME_pHaSe; + ; double NAME_pHaSe_iNcR; + ;----------------- + (format stream " double ~A_pHaSe;~%" name) + (format stream " double ~A_pHaSe_iNcR;~%" name))) + + (cond ((member 'RAMP interpolation) + ;----------------- + ; RAMP: + ; /* support for ramp between samples of NAME */ + ; double output_per_NAME; + ; long NAME_n; + ;----------------- + (format stream + "~% /* support for ramp between samples of ~A */~%" name) + (format stream " double output_per_~A;~%" name) + (format stream " long ~A_n;~%" name) )))) + + ;---------------------------- + ; STATE + ; TYPEi VARNAMEi ; + ;---------------------------- + ;; now write state variables + ;; (STATE (s1) (s2)... (sn) ) + ;; each (si) is of the form + ;; ("type" "varname" "?" [TEMP]) + (cond (state-list (format stream "~%"))) + (dolist (state state-list) + (cond ((equal "LVAL" (car state)) + (push (cadr state) xlisp-pointers))) + (cond ((and (cdddr state) + (cadddr state) + (eq (cadddr state) 'TEMP)) + ; no field allocated for local/temp variables + ) + (t + (let ((sep (space-if-no-trailing-star (car state)))) + (format stream " ~A~A~A;~%" + (car state) sep (cadr state)))))) + (put-slot alg xlisp-pointers 'xlisp-pointers) + + ;---------------------------- + ; } ALG-NAME_susp_node, *ALG-NAME_susp_type; + ;---------------------------- + (format stream "} ~A_susp_node, *~A_susp_type;~%" alg-name alg-name))) + +(print 'end) diff --git a/tran/upsample.alg b/tran/upsample.alg new file mode 100644 index 0000000..82aaca3 --- /dev/null +++ b/tran/upsample.alg @@ -0,0 +1,18 @@ +(UP-ALG + (NAME "up") + (ARGUMENTS ("rate_type" "sr") ("sound_type" "input")) + (INLINE-INTERPOLATION T) + (SAMPLE-RATE "sr") + (START (MIN input)) + (INNER-LOOP "output = (sample_type) input") + (LINEAR input) + (TERMINATE (MIN input)) + (LOGICAL-STOP (MIN input)) + (TYPE-CHECK +" if (input->sr > sr) { + sound_unref(input); + xlfail(\"snd-up: output sample rate must be higher than input\"); + } +") +) + diff --git a/tran/upsample.c b/tran/upsample.c new file mode 100644 index 0000000..a83c678 --- /dev/null +++ b/tran/upsample.c @@ -0,0 +1,448 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "upsample.h" + +void up_free(); + + +typedef struct up_susp_struct { + snd_susp_node susp; + boolean started; + long terminate_cnt; + boolean logically_stopped; + sound_type input; + long input_cnt; + sample_block_values_type input_ptr; + + /* support for interpolation of input */ + sample_type input_x1_sample; + double input_pHaSe; + double input_pHaSe_iNcR; + + /* support for ramp between samples of input */ + double output_per_input; + long input_n; +} up_susp_node, *up_susp_type; + + +void up_n_fetch(register up_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, "up_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 input input sample block: */ + susp_check_term_log_samples(input, input_ptr, input_cnt); + togo = min(togo, susp->input_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; + input_ptr_reg = susp->input_ptr; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) *input_ptr_reg++; + } while (--n); /* inner loop */ + + /* using input_ptr_reg is a bad idea on RS/6000: */ + susp->input_ptr += togo; + out_ptr += togo; + susp_took(input_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; + } +} /* up_n_fetch */ + + +void up_i_fetch(register up_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type input_x2_sample; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + register double input_pHaSe_iNcR_rEg = susp->input_pHaSe_iNcR; + register double input_pHaSe_ReG; + register sample_type input_x1_sample_reg; + falloc_sample_block(out, "up_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(input, input_ptr, input_cnt); + susp->input_x1_sample = susp_fetch_sample(input, input_ptr, input_cnt); + } + + susp_check_term_log_samples(input, input_ptr, input_cnt); + input_x2_sample = susp_current_sample(input, input_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) 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; + input_pHaSe_ReG = susp->input_pHaSe; + input_x1_sample_reg = susp->input_x1_sample; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ + if (input_pHaSe_ReG >= 1.0) { + input_x1_sample_reg = input_x2_sample; + /* pick up next sample as input_x2_sample: */ + susp->input_ptr++; + susp_took(input_cnt, 1); + input_pHaSe_ReG -= 1.0; + susp_check_term_log_samples_break(input, input_ptr, input_cnt, input_x2_sample); + } +*out_ptr_reg++ = (sample_type) + (input_x1_sample_reg * (1 - input_pHaSe_ReG) + input_x2_sample * input_pHaSe_ReG); + input_pHaSe_ReG += input_pHaSe_iNcR_rEg; + } while (--n); /* inner loop */ + + togo -= n; + susp->input_pHaSe = input_pHaSe_ReG; + susp->input_x1_sample = input_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; + } +} /* up_i_fetch */ + + +void up_r_fetch(register up_susp_type susp, snd_list_type snd_list) +{ + int cnt = 0; /* how many samples computed */ + sample_type input_DeLtA; + sample_type input_val; + sample_type input_x2_sample; + int togo; + int n; + sample_block_type out; + register sample_block_values_type out_ptr; + + register sample_block_values_type out_ptr_reg; + + falloc_sample_block(out, "up_r_fetch"); + out_ptr = out->samples; + snd_list->block = out; + + /* make sure sounds are primed with first values */ + if (!susp->started) { + susp->started = true; + susp->input_pHaSe = 1.0; + } + + susp_check_term_log_samples(input, input_ptr, input_cnt); + input_x2_sample = susp_current_sample(input, input_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; + + /* grab next input_x2_sample when phase goes past 1.0; */ + /* we use input_n (computed below) to avoid roundoff errors: */ + if (susp->input_n <= 0) { + susp->input_x1_sample = input_x2_sample; + susp->input_ptr++; + susp_took(input_cnt, 1); + susp->input_pHaSe -= 1.0; + susp_check_term_log_samples(input, input_ptr, input_cnt); + input_x2_sample = susp_current_sample(input, input_ptr); + /* input_n gets number of samples before phase exceeds 1.0: */ + susp->input_n = (long) ((1.0 - susp->input_pHaSe) * + susp->output_per_input); + } + togo = min(togo, susp->input_n); + input_DeLtA = (sample_type) ((input_x2_sample - susp->input_x1_sample) * susp->input_pHaSe_iNcR); + input_val = (sample_type) (susp->input_x1_sample * (1.0 - susp->input_pHaSe) + + input_x2_sample * susp->input_pHaSe); + + /* 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; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) input_val; + input_val += input_DeLtA; + } while (--n); /* inner loop */ + + out_ptr += togo; + susp->input_pHaSe += togo * susp->input_pHaSe_iNcR; + susp->input_n -= 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; + } +} /* up_r_fetch */ + + +void up_toss_fetch(susp, snd_list) + register up_susp_type susp; + snd_list_type snd_list; +{ + long final_count = susp->susp.toss_cnt; + time_type final_time = susp->susp.t0; + long n; + + /* fetch samples from input up to final_time for this block of zeros */ + while ((round((final_time - susp->input->t0) * susp->input->sr)) >= + susp->input->current) + susp_get_samples(input, input_ptr, input_cnt); + /* convert to normal processing when we hit final_count */ + /* we want each signal positioned at final_time */ + n = round((final_time - susp->input->t0) * susp->input->sr - + (susp->input->current - susp->input_cnt)); + susp->input_ptr += n; + susp_took(input_cnt, n); + susp->susp.fetch = susp->susp.keep_fetch; + (*(susp->susp.fetch))(susp, snd_list); +} + + +void up_mark(up_susp_type susp) +{ + sound_xlmark(susp->input); +} + + +void up_free(up_susp_type susp) +{ + sound_unref(susp->input); + ffree_generic(susp, sizeof(up_susp_node), "up_free"); +} + + +void up_print_tree(up_susp_type susp, int n) +{ + indent(n); + stdputstr("input:"); + sound_print_tree_1(susp->input, n); +} + + +sound_type snd_make_up(rate_type sr, sound_type input) +{ + register up_susp_type susp; + /* sr specified as input parameter */ + time_type t0 = input->t0; + int interp_desc = 0; + sample_type scale_factor = 1.0F; + time_type t0_min = t0; + /* combine scale factors of linear inputs (INPUT) */ + scale_factor *= input->scale; + input->scale = 1.0F; + + /* try to push scale_factor back to a low sr input */ + if (input->sr < sr) { input->scale = scale_factor; scale_factor = 1.0F; } + + if (input->sr > sr) { + sound_unref(input); + xlfail("snd-up: output sample rate must be higher than input"); + } + falloc_generic(susp, up_susp_node, "snd_make_up"); + + /* select a susp fn based on sample rates */ + interp_desc = (interp_desc << 2) + interp_style(input, sr); + switch (interp_desc) { + case INTERP_n: susp->susp.fetch = up_n_fetch; break; + case INTERP_i: susp->susp.fetch = up_i_fetch; break; + case INTERP_r: susp->susp.fetch = up_r_fetch; break; + default: snd_badsr(); break; + } + + susp->terminate_cnt = UNKNOWN; + /* handle unequal start times, if any */ + if (t0 < input->t0) sound_prepend_zeros(input, t0); + /* minimum start time over all inputs: */ + t0_min = min(input->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 = up_toss_fetch; + } + + /* initialize susp state */ + susp->susp.free = up_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = up_mark; + susp->susp.print_tree = up_print_tree; + susp->susp.name = "up"; + susp->logically_stopped = false; + susp->susp.log_stop_cnt = logical_stop_cnt_cvt(input); + susp->started = false; + susp->susp.current = 0; + susp->input = input; + susp->input_cnt = 0; + susp->input_pHaSe = 0.0; + susp->input_pHaSe_iNcR = input->sr / sr; + susp->input_n = 0; + susp->output_per_input = sr / input->sr; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_up(rate_type sr, sound_type input) +{ + sound_type input_copy = sound_copy(input); + return snd_make_up(sr, input_copy); +} diff --git a/tran/upsample.h b/tran/upsample.h new file mode 100644 index 0000000..5629b15 --- /dev/null +++ b/tran/upsample.h @@ -0,0 +1,3 @@ +sound_type snd_make_up(rate_type sr, sound_type input); +sound_type snd_up(rate_type sr, sound_type input); + /* LISP: (snd-up ANYNUM SOUND) */ diff --git a/tran/white.alg b/tran/white.alg new file mode 100644 index 0000000..8fc3832 --- /dev/null +++ b/tran/white.alg @@ -0,0 +1,24 @@ +(WHITE-ALG +(NAME "white") +(ARGUMENTS ("time_type" "t0") ("rate_type" "sr") ("time_type" "d")) +(STATE ) +(TERMINATE (AFTER "d")) +(INNER-LOOP "output = (sample_type) (rand() * rand_scale - 1.0);") +(SAMPLE-RATE "sr") +(SUPPORT-HEADER " +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 rbd all systems now use rand(), based on DM's modifications + */ + +#include <stdlib.h> +#include <math.h> + +/* rand returns from 0 to RAND_MAX. Scale and offset + * to get range from -1 to +1 + */ +#define rand_scale (2.0/RAND_MAX) + +") +) + diff --git a/tran/white.c b/tran/white.c new file mode 100644 index 0000000..a411562 --- /dev/null +++ b/tran/white.c @@ -0,0 +1,104 @@ +#include "stdio.h" +#ifndef mips +#include "stdlib.h" +#endif +#include "xlisp.h" +#include "sound.h" + +#include "falloc.h" +#include "cext.h" +#include "white.h" + +void white_free(); + + +typedef struct white_susp_struct { + snd_susp_node susp; + long terminate_cnt; +} white_susp_node, *white_susp_type; + + +void white__fetch(register white_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; + + falloc_sample_block(out, "white__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; + } + + n = togo; + out_ptr_reg = out_ptr; + if (n) do { /* the inner sample computation loop */ +*out_ptr_reg++ = (sample_type) (rand() * rand_scale - 1.0);; + } while (--n); /* inner loop */ + + 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; + } +} /* white__fetch */ + + +void white_free(white_susp_type susp) +{ + ffree_generic(susp, sizeof(white_susp_node), "white_free"); +} + + +void white_print_tree(white_susp_type susp, int n) +{ +} + + +sound_type snd_make_white(time_type t0, rate_type sr, time_type d) +{ + register white_susp_type susp; + /* sr specified as input parameter */ + /* t0 specified as input parameter */ + sample_type scale_factor = 1.0F; + falloc_generic(susp, white_susp_node, "snd_make_white"); + susp->susp.fetch = white__fetch; + + susp->terminate_cnt = round((d) * sr); + /* initialize susp state */ + susp->susp.free = white_free; + susp->susp.sr = sr; + susp->susp.t0 = t0; + susp->susp.mark = NULL; + susp->susp.print_tree = white_print_tree; + susp->susp.name = "white"; + susp->susp.log_stop_cnt = UNKNOWN; + susp->susp.current = 0; + return sound_create((snd_susp_type)susp, t0, sr, scale_factor); +} + + +sound_type snd_white(time_type t0, rate_type sr, time_type d) +{ + return snd_make_white(t0, sr, d); +} diff --git a/tran/white.h b/tran/white.h new file mode 100644 index 0000000..953a54d --- /dev/null +++ b/tran/white.h @@ -0,0 +1,17 @@ +sound_type snd_make_white(time_type t0, rate_type sr, time_type d); +sound_type snd_white(time_type t0, rate_type sr, time_type d); + /* LISP: (snd-white ANYNUM ANYNUM ANYNUM) */ + +/* CHANGE LOG + * -------------------------------------------------------------------- + * 28Apr03 rbd all systems now use rand(), based on DM's modifications + */ + +#include <stdlib.h> +#include <math.h> + +/* rand returns from 0 to RAND_MAX. Scale and offset + * to get range from -1 to +1 + */ +#define rand_scale (2.0/RAND_MAX) + diff --git a/tran/writemake.lsp b/tran/writemake.lsp new file mode 100644 index 0000000..52468c5 --- /dev/null +++ b/tran/writemake.lsp @@ -0,0 +1,934 @@ +;;************ +;; writemake.lsp -- generate the sound create routine +;;************ +;;************ +;; Change Log +;; Date | Change +;;-----------+-------------------- +;; 17-Dec-91 | [1.1] <jmn> Created +;; 17-Dec-91 | [1.1] <jmn> return sound_create(...) cast type to correct +;; | type +;; 21-Dec-91 | [1.2] <jmn> added start-time, default 0.0 +;; 21-Dec-91 | [1.2] <jmn> prefix creation local variables with C_ +;; 13-Jan-92 | [1.2] <jmn> reformatted and recommented +;; 3-May-99 | <rbd> modified toss_fetch code to retain proper t0 +;;************ + + + +;; check-for-no-interpolation - if you see an "s", make sure there +;; is a corresponding "n", if not use "s" to cover the "n" case. And vice versa. +;; +(defun check-for-no-interpolation (encoding interpolation-rationale stream) + ; *cfni-output* used to keep track of newline output + (setf *cfni-output* nil) + (check-for-no-interpolation-1 encoding 0 interpolation-rationale stream)) + +;; Hint: this algorithm constructs the 2^n variations by substituting +;; (or not) 'n' for 's' whereever s'es occur. The search is cut off +;; however, when an altered string is found in the encoding-list, which +;; tells what cases are handled directly. +;; +;; Wow, returning to the description above after several months, I couldn't make +;; heads or tails of it, and I wrote it! Here's another perhaps better, description: +;; +;; We generated various _fetch routines that differ in their assumptions about how to +;; access signal arguments. There are (now) 4 variations: NONE, SCALE, INTERP, and +;; RAMP. All 4^N combinations of these are generated initially, but many combinations +;; are deleted before any code is generated. Reasons for removing a combination include +;; the use of symetry, linearity, and simply the promise that input arguments will be +;; interpolated externally. In most of these cases, combinations are removed because +;; they cannot occur in practice. But in others, combinations are removed because they +;; should be handled by different code. For example, an input signal matching the output +;; sample rate and with a scale factor of 1 is normally handled by NONE style +;; "interpolation". Note: "interpolation" is used throughout this code, but a better term +;; would be "access method," because no interpolation is involved in the NONE and +;; SCALE variants. The inner loop access code for NONE style is something like "*s++". +;; However, an input signal suitable for NONE style interpolation can also be handled +;; by SCALE style interpolation (which looks something like "(*s++ * s_scale)", i.e. +;; an extra multiplication is required. If the attribute INTERNAL-SCALING is used, +;; then the scale factor does not actually appear at the access point because it has been +;; factored into a filter coefficient or some other factor, saving the multiply. +;; Alternatively, the ALWAYS-SCALE attribute can specify that there is little to be +;; gained by saving a multiply. In these cases, we want to handle NONE style signals +;; with SCALE style interpolation. Let's run through these possibilities again and +;; describe how they are handled: +;; +;; ALWAYS-SCALE: here we delete the NONE variant(s) and only generate fetch +;; routines that have scaling code in them. When we get an actual parameter with +;; a scale factor of 1 (implying NONE interpolation), we handle it with the SCALE +;; fetch routine. +;; INTERNAL-SCALING: here we generate NONE fetch routines because the +;; scale factor is taken care of elsewhere in the code, e.g. in a filter coefficient. +;; LINEAR: here, the scale factor of the actual argument becomes a scale factor +;; on the output (part of the data structure), deferring multiplies until later. We +;; then modify the argument scale factor to 1, and NONE style interpolation applies. +;; There is no need to generate SCALE style routines, because there will never be +;; any need for them. +;; +;; For a given signal parameter, these 3 cases are mutually exclusive. +;; +;; Looking at these three cases, we see that sometimes there will be SCALE style +;; routines handling NONE arguments, sometimes NONE style routines handling +;; SCALE arguments, and sometimes NONE style routines because there will +;; never be a need for SCALE. +;; This code is going to generate labels so that other fetch routines +;; handle the "missing" ones. +;; To do this, we generate extra labels in the case +;; statement that selects the fetch routine (interpolation is in the inner loop in the +;; fetch routine. For example, we might generate this code: +;; ... +;; case INTERP_nn: +;; case INTERP_sn: +;; case INTERP_ns: +;; case INTERP_ss: susp->susp.fetch = tonev_ss_fetch; break; +;; ... +;; Here, a single fetch routine (tonev_ss_fetch) handles all variations of NONE and +;; SCALE (n and s) types of the two signal arguments. The basic rule is: if you did not +;; generate a fetch routine for the NONE case, then handle it with the SCALE case, and +;; if you did not generate a fetch routine for the SCALE case, handle it with the NONE +;; case. +;; +;; The algorithm uses the list interpolation-rationale, which lists for each sound +;; parameter one of {NIL, LINEAR, ALWAYS-SCALE, INTERNAL-SCALING}. +;; Using this list, the code enumerates all the possible cases that might be handled +;; by the current fetch routine (represented by the "encoding" parameter). +;; This is a recursive algorithm because, if there are n SCALE type parameters, then +;; there are 2^N possible variations to enumerate. (E.g. look at the 4 variations in +;; the code example above.) +;; +;; +(defun check-for-no-interpolation-1 (encoding index + interpolation-rationale stream) + (cond ((= index (length encoding)) + (display "check-for-no-interpolation output" encoding) + ; see if we need a newline (*cfni-output* is initially nil) + (if *cfni-output* (format stream "/* handled below */~%")) + (setf *cfni-output* t) + (format stream " case INTERP_~A: " encoding)) + (t + (let ((ch (char encoding index))) + (display "cfni" index ch) + (cond ((eql ch #\s) + (let ((new-encoding (strcat (subseq encoding 0 index) + "n" + (subseq encoding (1+ index))))) + (cond ((eq (nth index interpolation-rationale) 'ALWAYS-SCALE) + (check-for-no-interpolation-1 new-encoding (1+ index) + interpolation-rationale stream))))) + ((eql ch #\n) + (let ((new-encoding (strcat (subseq encoding 0 index) + "s" + (subseq encoding (1+ index))))) + (cond ((eq (nth index interpolation-rationale) 'INTERNAL-SCALING) + (check-for-no-interpolation-1 new-encoding (1+ index) + interpolation-rationale stream)))))) + (check-for-no-interpolation-1 encoding (1+ index) + interpolation-rationale stream))))) + +;;************ +;; is-argument -- see if string is in argument list +;; +;;************ + +(defun is-argument (arg arguments) + (dolist (a arguments) + (cond ((equal arg (cadr a)) (return t))))) + + + +;; needs-mark-routine -- is there anything for GC to mark here? +;; +(defun needs-mark-routine (alg) + (or (get-slot alg 'sound-names) + (get-slot alg 'xlisp-pointers))) + + +;; lsc-needed-p -- see if we need the lsc variable declared +(defun lsc-needed-p (alg) + (let ((spec (get-slot alg 'logical-stop))) + (and spec (listp (car spec)) + (eq (caar spec) 'MIN) + (cdar spec) + (cddar spec)))) + + +;; write-initial-logical-stop-cnt -- writes part of snd_make_<name> +;; +(defun write-initial-logical-stop-cnt (alg stream) + (let ((spec (get-slot alg 'logical-stop)) + min-list) + (cond ((and spec (listp (car spec)) + (eq (caar spec) 'MIN) + (cdar spec)) + (setf min-list (cdar spec)) + ; take stop_cnt from first argument in MIN list + (format stream + " susp->susp.log_stop_cnt = logical_stop_cnt_cvt(~A);\n" + (symbol-to-name (cadar spec))) + ; modify stop_cnt to be minimum over all remaining arguments + (dolist (sym (cddar spec)) + (let ((name (symbol-to-name sym))) + (format stream + " lsc = logical_stop_cnt_cvt(~A);\n" name) + (format stream + " if (susp->susp.log_stop_cnt > lsc)\n" + name) + (format stream + " susp->susp.log_stop_cnt = lsc;\n" + name)))) + (t + (format stream + " susp->susp.log_stop_cnt = UNKNOWN;\n"))) +)) + + +;;************ +;; write-mark +;; +;; Inputs: +;; alg - algorithm description +;; stream - stream on which to write .c file +;; Effect: +;; writes NAME_mark(...) +;;************ + +(defun write-mark (alg stream) + (let ((name (get-slot alg 'name)) + (sound-names (get-slot alg 'sound-names)) + (xlisp-pointers (get-slot alg 'xlisp-pointers))) + ;---------------- + ; void NAME_mark(NAME_susp_type susp) + ; { + ; *WATCH*: printf("NAME_mark(%x)\n", susp); + ;---------------- + (format stream "~%~%void ~A_mark(~A_susp_type susp)~%{~%" name name) + (if *WATCH* + (format stream + " printf(\"~A_mark(%x)\\n\", susp);~%" name)) + + ;---------------- + ; for each LVAL argument: + ; + ; if (susp->NAME) mark(susp->NAME); + ;---------------- + (dolist (name xlisp-pointers) + (format stream " if (susp->~A) mark(susp->~A);~%" name name)) + + ;---------------- + ; for each sound argument: + ; + ; *WATCH*: printf("marking SND@%x in NAME@%x\n", susp->snd, susp); + ; sound_xlmark(susp->NAME); + ;---------------- + (dolist (snd sound-names) + (if *watch* + (format stream + " printf(\"marking ~A@%x in ~A@%x\\n\", susp->~A, susp);~%" + snd name snd)) + (format stream " sound_xlmark(susp->~A);~%" snd)) + + ;---------------- + ; } + ;---------------- + (format stream "}~%"))) + +(print 'write-mark) + +;;************ +;; write-make +;; +;; Inputs: +;; alg - algorithm description +;; stream - stream on which to write .c file +;; Effect: +;; writes NAME_free(...), NAME_print_tree, and snd_make_NAME(...) +;;************ + +(defun write-make (alg stream) + (let ((name (get-slot alg 'name)) + (sr (get-slot alg 'sample-rate)) + (else-prefix "") + first-time + (sound-names (get-slot alg 'sound-names)) + (logical-stop (car (get-slot alg 'logical-stop))) + (sound-to-name (get-slot alg 'sound-to-name)) + (state-list (get-slot alg 'state)) + (linear (get-slot alg 'linear)) + (arguments (get-slot alg 'arguments)) + (finalization (get-slot alg 'finalization)) + (interpolation-list (get-slot alg 'interpolation-list)) + (interpolation-rationale (get-slot alg 'interpolation-rationale)) + encoding-list + (terminate (car (get-slot alg 'terminate))) + (type-check (car (get-slot alg 'type-check))) + (delay (get-slot alg 'delay)) + (start (get-slot alg 'start))) + + ;-------------------- + ; void NAME_free(NAME_susp_type susp) + ; { + ;---------------- + (format stream "~%~%void ~A_free(~A_susp_type susp)~%{~%" + name name) + + ;---------------- + ; if there's a finalization, do it + ;---------------- + (if finalization (print-strings finalization stream)) + + ;---------------- + ; for each sound argument: + ; + ; sound_unref(susp->NAME); + ;---------------- + (dolist (name sound-names) + (format stream " sound_unref(susp->~A);~%" name)) + + ;---------------- + ; ffree_generic(susp, sizeof(NAME_susp_node), "fn-name"); + ; } + ;-------------------- + (format stream + " ffree_generic(susp, sizeof(~A_susp_node), \"~A_free\");~%}~%" + name name) + + ;-------------------- + ; void NAME_print_tree(NAME_susp_type susp, int n) + ; { + ;---------------- + (format stream "~%~%void ~A_print_tree(~A_susp_type susp, int n)~%{~%" + name name) + ;---------------- + ; for each sound argument: + ; + ; indent(n); + ; printf("NAME:"); + ; sound_print_tree_1(susp->NAME, n); + ;---------------- + (setf first-time t) + (dolist (name sound-names) + (cond (first-time + (setf first-time nil)) + (t ; space between each iteration + (format stream "~%"))) + (format stream " indent(n);~% stdputstr(\"~A:\");~%" name) + (format stream " sound_print_tree_1(susp->~A, n);~%" name)) + + ;---------------- + ; } + ;-------------------- + (format stream "}~%") + + ;-------------------- + ; sound_type snd_make_NAME + ;-------------------- + + (format stream "~%~%sound_type snd_make_~A" name) + + ;-------------------- + ; ( type name, ...) + ;-------------------- + + (write-ansi-parameter-list stream "" arguments) + (format stream "~%") + (if (not *ANSI*) + (dolist (arg arguments) + (format stream " ~A ~A;~%" (car arg) (cadr arg)))) + + ;-------------------- + ; NAME_susp_type susp; + ;-------------------- + (format stream + "{~% register ~A_susp_type susp;~%" name); + + ;; declare "state" variables with TEMP flag + ;-------------------- + ; <type[i]> <name[i]>; + ;-------------------- + (dolist (state state-list) + (cond ((and (cdddr state) + (cadddr state) + (eq (cadddr state) 'TEMP)) + (format stream " ~A ~A;~%" + (car state) (cadr state))))) + + (write-sample-rate stream sr sound-names arguments) + + ; compute the t0 for new signal (default: use zero): + ; + (write-start-time stream start arguments) + + ;-------------------- + ; int interp_desc = 0; + ;-------------------- + (cond (interpolation-list + (format stream " int interp_desc = 0;~%"))) + + ;-------------------- + ; sample_type scale_factor = 1.0F; + ; time_type t0_min; -- but only if there are sound args, implied by non-null sound-names + ; long lsc; + ;-------------------- + (format stream " sample_type scale_factor = 1.0F;~%") + (if sound-names (format stream " time_type t0_min = t0;~%")) + (if (lsc-needed-p alg) + (format stream " long lsc;~%")) + + ; now do canonical ordering of commutable sounds + ; + (dolist (lis (get-slot alg 'commutative)) + ;-------------------- + ; /* sort commuative signals: s1 s2 ... */ + ; snd_sort_<n> + ; (...) + ;-------------------- + (format stream " /* sort commutative signals: ~A */~%" lis) + (format stream " snd_sort_~A" (length lis)) + (write-parameter-list stream "" + (append (mapcar + '(lambda (snd) + (strcat "&" (cdr (assoc snd sound-to-name)))) + lis) + '("sr"))) + (format stream ";~%~%")) + + ; figure scale factor -- if signal is linear wrt some interpolated or + ; ramped signal (which do the multiply anyway), then put the scale + ; factor there. + ;-------------------- + ; /* combine scale factors of linear inputs <linear> */ + ;-------------------- + + (cond (linear + (format stream + " /* combine scale factors of linear inputs ~A */~%" linear))) + ;-------------------- + ; scale_factor *= NAME ->scale; + ; NAME ->scale = 1.0F; + ;-------------------- + + (dolist (snd linear) + (let ((name (cdr (assoc snd sound-to-name)))) + (format stream " scale_factor *= ~A->scale;~%" name) + (format stream " ~A->scale = 1.0F;~%" name))) + + ;-------------------- + ; /* try to push scale_factor back to a low sr input */ + ;-------------------- + + (cond (linear + (format stream + "~% /* try to push scale_factor back to a low sr input */~%"))) + + ;-------------------- + ; if (NAME ->sr < sr) { + ; NAME ->scale = scale_factor; scale_factor = 1.0F; } + ;-------------------- + + (dolist (snd linear) + (let ((name (cdr (assoc snd sound-to-name)))) + (format stream +" ~Aif (~A->sr < sr) { ~A->scale = scale_factor; scale_factor = 1.0F; }~%" + else-prefix name name) + (setf else-prefix "else "))) + (if linear (format stream "~%")) + + ;------------------- + ; insert TYPE-CHECK code here + ;------------------- + (display "write-make" type-check) + (if type-check + (format stream type-check)) + + ;-------------------- + ; falloc_generic(susp, NAME_susp_node, "fn-name"); + ;-------------------- + (format stream + " falloc_generic(susp, ~A_susp_node, \"snd_make_~A\");~%" name name) + + ;; initialize state: the state list has (type field initialization [temp]) + ;-------------------- + ; susp-> <state[i]> = <value[i]> + ;-------------------- + ;; if TEMP is present, generate: + ;-------------------- + ; <state[i]> = <value[i]> + ;-------------------- + + (dolist (state state-list) + (let ((prefix "susp->")) + (cond ((and (cdddr state) + (cadddr state) + (eq (cadddr state) 'TEMP)) + (setf prefix ""))) + (format stream " ~A~A = ~A;~%" + prefix (cadr state) (caddr state)))) + + ; if we have a choice of implementations, select one + (cond ((< 1 (length interpolation-list)) + + ;-------------------- + ; /* select a susp fn based on sample rates */ + ;-------------------- + ; build a descriptor + (format stream + "~% /* select a susp fn based on sample rates */~%") + + ;------------------------ + ; interp_desc = (interp_desc << 2) + interp_style( NAME, sr); + ;------------------------ + (dolist (snd sound-names) + (format stream + " interp_desc = (interp_desc << 2) + interp_style(~A, sr);~%" + snd)) + + ;-------------------- + ; switch (interp_desc) { + ;-------------------- + (cond (interpolation-list + (format stream " switch (interp_desc) {~%"))) + + ;-------------------------- + ; case INTERP_<encoding>: susp->susp.fetch = + ; NAME_<encoding>_fetch; break; + ;-------------------------- + (setf encoding-list (mapcar #'encode interpolation-list)) + (dolist (encoding encoding-list) + (check-for-no-interpolation encoding interpolation-rationale stream) + (format stream "susp->susp.fetch = ~A_~A_fetch; break;~%" + name encoding)) + ;-------------------------- + ; default: snd_badsr(); break; + ;-------------------------- + (format stream " default: snd_badsr(); break;~%") + ;-------------------- + ; } /* initialize susp state */ + ;------------------------- + (format stream " }~%~%")) + (interpolation-list + (format stream " susp->susp.fetch = ~A_~A_fetch;~%" + name (encode (car interpolation-list)))) + (t + ;------------------------- + ; susp->susp.fetch = NAME__fetch; + ;------------------------- + (format stream " susp->susp.fetch = ~A__fetch;~%~%" name))) + + ;---------------- + ; /* compute terminate count */ + ;---------------- + (cond ((terminate-check-needed terminate alg) + (cond ((eq (car terminate) 'AT) + (let ((time-expr (cadr terminate))) + ;---------------- + ; susp->terminate_cnt = round(((TIME-EXPR) - t0) * sr); + ;---------------- + (format stream + " susp->terminate_cnt = round(((~A) - t0) * sr);~%" + time-expr))) + ((eq (car terminate) 'AFTER) + (let ((dur-expr (cadr terminate))) + ;---------------- + ; susp->terminate_cnt = round((DUR-EXPR) * sr); + ;---------------- + (format stream + " susp->terminate_cnt = round((~A) * sr);~%" + dur-expr))) + (t + ;---------------- + ; susp->terminate_cnt = UNKNOWN; + ;---------------- + (format stream " susp->terminate_cnt = UNKNOWN;~%"))))) + + ;---------------- + ; /* handle unequal start times, if any */ + ;---------------- + (if sound-names + (format stream " /* handle unequal start times, if any */~%")) + ;---------------- + ; for each sound argument: + ; if (t0 < NAME->t0) sound_prepend_zeros(NAME, t0); + ;---------------- + (dolist (name sound-names) + (format stream + " if (t0 < ~A->t0) sound_prepend_zeros(~A, t0);~%" name name)) + ;---------------- + ; t0_min = min(NAME1->t0, min(NAME2->t0, ... NAMEn->t0, t0)...); + ;---------------- + (cond (sound-names + (format stream " /* minimum start time over all inputs: */~%") + (format stream " t0_min = ") + (dolist (name sound-names) + (format stream "min(~A->t0, " name)) + (format stream "t0") + (dolist (name sound-names) + (format stream ")")) + (format stream ";~%"))) + + ;---------------- + ; /* how many samples to toss before t0: */ + ; susp->susp.toss_cnt = (long) ((t0 - t0_min) * sr + <DELAY>.5); + ; if (susp->susp.toss_cnt > 0) { + ; susp->susp.keep_fetch = susp->susp.fetch; + ; susp->susp.fetch = NAME_toss_fetch; + ; t0 = t0_min; -- DELETED 3MAY99 by RBD + ; } + ;---------------- + (cond (sound-names + (format stream " /* how many samples to toss before t0: */\n") + (if delay + (format stream " /* Toss an extra ~A samples to make up for internal buffering: */\n" delay)) + (format stream " susp->susp.toss_cnt = (long) ((t0 - t0_min) * sr + ~A.5);\n" + (if delay delay 0)) + (format stream " if (susp->susp.toss_cnt > 0) {\n") + (format stream "\tsusp->susp.keep_fetch = susp->susp.fetch;\n") + (format stream "\tsusp->susp.fetch = ~A_toss_fetch;~%" name) +; (format stream "\tt0 = t0_min;~% }\n\n"))) + (format stream " }\n\n"))) + + ;-------------------- + ; /* initialize susp state */ + ; susp->susp.free = NAME_free; + ; susp->susp.sr = sr; + ; susp->susp.t0 = t0; + ;-------------------- + (format stream " /* initialize susp state */~%") + (format stream " susp->susp.free = ~A_free;~%" name) + (format stream " susp->susp.sr = sr;~%") + (format stream " susp->susp.t0 = t0;~%") + + ;---------------- + ; if there are sound arguments: + ; susp->susp.mark = NAME_mark; + ; otherwise... + ; susp->susp.mark = NULL; + ;---------------- + (let ((value "NULL")) + (cond ((needs-mark-routine alg) + (setf value (strcat name "_mark")))) + (format stream " susp->susp.mark = ~A;~%" value)) + + ;---------------- + ; for debugging... + ; susp->susp.print_tree = NAME_print_tree; + ; susp->susp.name = "NAME"; + ;---------------- + (format stream " susp->susp.print_tree = ~A_print_tree;~%" name) + (format stream " susp->susp.name = \"~A\";~%" name) + + ;---------------- + ; if there is a logical stop attribute: + ; susp->logically_stopped = false; + ; susp->susp.log_stop_cnt = UNKNOWN; + ;---------------- + (cond ((logical-stop-check-needed logical-stop) + (format stream + " susp->logically_stopped = false;\n"))) + (write-initial-logical-stop-cnt alg stream) + + ;-------------------- + ; ramped or interpolated: + ; + ; susp->started = false; + ;-------------------- + (cond ((any-ramp-or-interp-in interpolation-list) + (format stream " susp->started = false;~%"))) + + ;-------------------- + ; susp->susp.current = 0; + ;-------------------- + (format stream " susp->susp.current = 0;~%") + + ;---------------------------- + ; For each sound arg: + ; + ; susp-> <arg> = <arg>; + ; susp-> <arg>_cnt = 0; + ;---------------------------- + + (dotimes (n (length (get alg 'sound-args))) + (let ((interpolation (union-of-nth interpolation-list n))) + (setf arg (nth n sound-names)) ; get name of signal + (format stream " susp->~A = ~A;~%" arg arg) + (format stream " susp->~A_cnt = 0;~%" arg) + ;----------------------------------------------- + ; Interpolation: + ; + ; susp-> <arg>_pHaSe = 0.0; + ; susp-> <arg>_pHaSe_iNcR = <arg> ->sr + ;----------------------------------------------- + (cond ((member 'INTERP interpolation) + (format stream " susp->~A_pHaSe = 0.0;~%" arg) + (format stream " susp->~A_pHaSe_iNcR = ~A->sr / sr;~%" + arg arg))) + ;----------------------------------------------- + ; Ramp: + ; + ; susp->output_per_<arg> = <arg> ->sr; + ;----------------------------------------------- + + (cond ((member 'RAMP interpolation) + (format stream " susp->~A_n = 0;~%" arg) + (format stream " susp->output_per_~A = sr / ~A->sr;~%" + arg arg))))) + + ;---------------------------- + ; return sound_create (snd_susp_type)susp, t0, sr, scale_factor); + ;---------------------------- + + (format stream + " return sound_create((snd_susp_type)susp, t0, sr, scale_factor);~%}~%"))) + + +(print 'write-make) + +;;************ +;; write-parameter-list -- with comma separator, open and close parens +;; +;;************ + +(defun write-parameter-list (stream prefix strings) + (let ((comma "")) + (format stream "(") + (dolist (parm strings) + (format stream "~A~A~A" comma prefix parm) + (setf comma ", ")) + (format stream ")"))) + +;;************ +;; write-ansi-prototype-list -- with comma separator, open and close parens +;; +;; Inputs: +;; stream - output stream +;; prefix - arg prefix, perhaps "" +;; args - argument type/name pairs of the form +;; ( (type1 name1) (type2 name2) ... ) +;; Effect: +;; if *ANSI* is set T, writes ANSI-style parameter list of the form +;; type name, ... +;; if *ANSI* is set NIL, writes antique-style parameter list of the form +;; () +;;************ + +(defun write-ansi-prototype-list (stream prefix args) + (let ((comma "")) + (format stream "(") + (if *ANSI* + (dolist (parm args) + ;-------------------- + ; for each parameter + ; <comma>type <prefix><parm> + ;-------------------- + (format stream "~A~A ~A~A" comma (car parm) prefix (cadr parm)) + (setf comma ", ")) + ) + (format stream ")"))) + +;;************ +;; write-ansi-parameter-list +;; +;; Inputs: +;; stream - output stream +;; prefix - arg prefix, perhaps "" +;; args - argument type/name pairs of the form +;; ( (type1 name1) (type2 name2) ... ) +;; Effect: +;; if *ANSI* is set T, writes ANSI-style parameter list of the form +;; (type name, ...) +;; if *ANSI* is set NIL, writes antique-style parameter list of the form +;; (name, ...) +;; Note: +;; to get a space between types and arguments, a space is prepended to prefix if +;; this is an *ANSI* arg list. +;;************ + +(defun write-ansi-parameter-list (stream prefix args) + (let ((comma "")) + (format stream "(") + (cond (*ANSI* + (setf prefix (strcat " " prefix)))) + (dolist (parm args) + (format stream "~A~A~A~A" comma + (if *ANSI* (car parm) "") + prefix (cadr parm)) + (setf comma ", ") + ) + (format stream ")"))) + +;;************ +;; write-sample-rate +;; Effect: +;; declare sr and compute the sample rate for the new signal +;; Notes: +;; If sr is an input parameter, it is not declared +;; If (SAMPLE-RATE expr) is specified, declare sr to be initialized +;; to the expr +;; If (SAMPLE-RATE (MAX s1 s2 ...)), sr is initialized to the max. +;; Otherwise, sr is initialized to the max of the sample rates of +;; all the sound-type arguments +;;************ + +(defun write-sample-rate (stream sr sound-names arguments) + ;; if sr is "sr" and "sr" is a parameter, then do nothing: + + (display "write-sample-rate: " sr sound-names arguments) + + (cond ( (and (equal sr "sr") (is-argument "sr" arguments)) + ;--------------------- + ; /* sr specified as input parameter */ + ;--------------------- + (format stream " /* sr specified as input parameter */~%") + ) + ;; else if sample rate is specified, use it to initialize sr: + ((stringp sr) + (display "write-sample-rate: using specified sr" sr) + ;--------------------- + ; rate_type sr = <sr>; + ;--------------------- + (format stream " rate_type sr = ~A;~%" sr) + ) + ;; else look for (MAX ...) expression + ((and (listp sr) (eq (car sr) 'MAX)) + (format stream " rate_type sr = ") + (write-redux-of-names stream "max" + (mapcar #'symbol-to-name (cdr sr)) "->sr") + (format stream ";~%") + ) + ;; else assume sr is max of sr's of all sound arguments + (sound-names + ;--------------------- + ; rate_type sr = max( <arg[0]> ->sr, <arg[i]> ->sr); + ;--------------------- + (format stream " rate_type sr = ") ; jmn + (write-redux-of-names stream "max" sound-names "->sr") + (format stream ";~%") + ) + (t + (error "Missing SAMPLE-RATE specification.")) + ) +) + + +(defun write-redux-of-names (stream fn sound-names suffix) + (dotimes (n (1- (length sound-names))) + (format stream "~A(" fn)) + (format stream "~A~A" (car sound-names) suffix) + (dolist (snd (cdr sound-names)) + (format stream ", ~A~A)" snd suffix))) + + + +;;************ +;; write-start-time +;; Effect: +;; declare sr and compute the start time for the new signal +;; Notes: +;; If t0 is an input parameter, it is not declared +;; If (START (AT expr)) is specified, declare t0 to be initialized +;; to the expr +;; Otherwise, t0 is initialized to 0 +;;************ + +(defun write-start-time (stream start arguments) + ;; if t0 is "t0" and "t0" is a parameter, then do nothing: + (display "write-start time:" start arguments) + (cond ((is-argument "t0" arguments) + ;--------------------- + ; /* t0 specified as input parameter */ + ;--------------------- + (format stream " /* t0 specified as input parameter */~%")) + ;; else if start time is specified, use it to initialize sr: + (t (cond (start + ;--------------- + ; (START (AT <expr>)) specified: + ; + ; time_type t0 = <expr>; + ;--------------- + (setf start (car start)) + (cond ((eq (car start) 'AT) + (format stream " time_type t0 = ~A;~%" (cadr start))) + ((eq (car start) 'MIN) + (format stream " time_type t0 = ") + (write-redux-of-names stream "min" + (c-names (cdr start)) "->t0") + (format stream ";~%")) + ((eq (car start) 'MAX) + (format stream " time_type t0 = ") + (write-redux-of-names stream "max" + (c-names (cdr start)) "->t0") + (format stream ";~%")) + (t (error (format nil + "Unrecognized START specification ~A" start))))) + ;--------------- + ; time_type t0 = 0.0; + ;--------------- + (t (format stream " time_type t0 = 0.0;~%")))))) + + +;; c-names -- get the C names corresponding to list of symbols +;; +(defun c-names (syms) (mapcar '(lambda (sym) (string-downcase (symbol-name sym))) syms)) + +(defun is-table (alg snd) + (dolist (table (get-slot alg 'table)) + (cond ((equal snd table) + (display "is-table" snd table) + (return t))))) + + +;; write-xlmake -- write out a function snd_NAME to be called by xlisp +; +; this function copies any sound arguments and passes them on to snd_make_NAME +; +(defun write-xlmake (alg stream) + (let ((name (get-slot alg 'name)) + (sound-names (get-slot alg 'sound-names)) + (arguments (get-slot alg 'arguments)) + comma) + ;-------------------- + ; sound_type snd_NAME + ;-------------------- + + (format stream "~%~%sound_type snd_~A" name) + + ;-------------------- + ; ( type name, ...) + ; { + ;-------------------- + + (write-ansi-parameter-list stream "" arguments) + (format stream "~%") + (if (not *ANSI*) + (dolist (arg arguments) + (format stream " ~A ~A;~%" (car arg) (cadr arg)))) + (format stream "{~%") + + ;---------------- + ; for each sound argument that is not a table + ; sound_type SND_copy = sound_copy(SND); + ;---------------- + + (dolist (arg arguments) + (cond ((equal (car arg) "sound_type") + (let ((snd (cadr arg))) + (cond ((not (is-table alg snd)) + (format stream + " sound_type ~A_copy = sound_copy(~A);~%" + snd snd))))))) + + ;---------------- + ; now call snd_make_ALG. When SND is a sound_type that is not a table, + ; substitute SND_copy for SND. + ;---------------- + + (format stream " return snd_make_~A(" name) + (setf comma "") + (dolist (arg arguments) + (let ((suffix "")) + (cond ((and (equal (car arg) "sound_type") + (not (is-table alg (cadr arg)))) + (setf suffix "_copy"))) + (format stream "~A~A~A" comma (cadr arg) suffix) + (setf comma ", "))) + (format stream ");~%}~%"))) diff --git a/tran/writesusp.lsp b/tran/writesusp.lsp new file mode 100644 index 0000000..77595f6 --- /dev/null +++ b/tran/writesusp.lsp @@ -0,0 +1,1025 @@ +;;************ +;; Change Log +;; Date | Change +;;----------+--------------------- +;; 17-Dec-91 | [1.1] <jmn> Created +;; 17-Dec-91 | [1.1] <jmn> cast arg of snd_list_create to correct type +;; 17-Dec-91 | [1.1] <jmn> cast truncation as (int) explicitly, avoid lint +;; | errors +;; 13-Jan-92 | [1.2] <jmn> reformatted and recommented +;;************ + +;;**************** +;; depended-on-in-inner-loop - test if variables updated in inner loop +;;**************** +(defun depended-on-in-inner-loop (vars interp sound-names step-function) + (dotimes (n (length interp)) + (let ((method (nth n interp)) + (name (nth n sound-names)) + interpolate-samples) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + (cond ((and (or (member method '(NONE SCALE INTERP)) + interpolate-samples) + (member name vars :test #'equal)) + (return t)))))) + +;;**************** +;; fixup-depends-prime - write code to update depend variables +;; this code is only run the first time the suspension +;; is invoked +;;**************** +(defun fixup-depends-prime (alg stream name indent var-name) + (let ((depends (get-slot alg 'depends))) + (dolist (dep depends) + (cond ((equal name (cadr dep)) + (cond ((eq (cadddr dep) 'TEMP) + (format stream "~A~A = ~A;~%" indent (car dep) + (fixup-substitutions-prime alg + (caddr dep) name var-name))) + (t + (format stream "~Asusp->~A = ~A;~%" indent (car dep) + (fixup-substitutions-prime alg + (caddr dep) name var-name))))))))) + +(print 'fixup-depends-prime) + + +;;**************** +;; fixup-depends-prime-decls - write declarations for temp depend variables +;; this code is only run the first time the suspension +;; is invoked +;;**************** +(defun fixup-depends-prime-decls (alg stream name) + (let ((depends (get-slot alg 'depends))) + (dolist (dep depends) + (cond ((equal name (cadr dep)) + (cond ((eq (cadddr dep) 'TEMP) + (format stream "\t ~A ~A;~%" (car (cddddr dep)) + (car dep))))))))) + +(print 'fixup-depends-prime-decls) + + +;;**************** +;; fixup-substitutions-prime - substitute susp-><var> for <var> for each +;; state variable in code, also substitute var-name for name +;; (this is the depended-on value) +;;**************** +(defun fixup-substitutions-prime (alg code name var-name) + (dolist (state (get-slot alg 'state)) + (let ((var (cadr state))) + (setf code (substitute code var (strcat "susp->" var) t)))) + (if name (setf code (substitute code name var-name nil))) + code) + +(print 'fixup-substitutions-prime) + +;; fixup-substitutions-for-depends is used to prepare joint-dependency +;; code for use outside the inner loop. In this position, the state +;; variables must be accessed using "susp-><name>" and signals must +;; be accessed using the local variable <name>_val +;; +(defun fixup-substitutions-for-depends (alg code) + (setf code (fixup-substitutions-prime alg code nil nil)) + (let ((interp (get alg 'interpolation)) + (step-function (get-slot alg 'step-function)) + (sound-names (get-slot alg 'sound-names))) + (dotimes (n (length interp)) + ;(display "fixup-loop" n name interp sound-names) + (let* ((name (nth n sound-names)) + (method (nth n interp)) + (is-step (member (name-to-symbol name) step-function))) + (cond ((and is-step (eq method 'RAMP)) + (setf code (substitute code name (strcat name "_val") t)) + ;(display "fixup-check" name) + )))) + code)) + + + +;;**************** +;; fixup-depends - write code to declare and update depend variables +;; this is called at declaration time (the point where +;; declarations should be output), but also generates code +;; to be output after the depended-on variable is updated +;;**************** +(defun fixup-depends (alg stream name) + (format stream "/* fixup-depends ~A */~%" name) + (let ((depends (get-slot alg 'depends)) + (fixup-code "") + (var-name (strcat name "_x1_sample_reg"))) + (dolist (dep depends) + (cond ((equal name (cadr dep)) + (cond ((eq (cadddr dep) 'TEMP) + (format stream "\t\t~A ~A; ~%" (car (cddddr dep)) + (car dep)) + (setf fixup-code + (format nil "~A\t\t~A = ~A;~%" + fixup-code (car dep) + (fixup-substitutions alg + (caddr dep) name var-name)))) + (t + (setf fixup-code + (format nil "~A\t\t~A_reg = susp->~A = ~A;~%" + fixup-code (car dep) (car dep) + (fixup-substitutions alg + (caddr dep) name var-name)))))))) + (put-slot alg fixup-code 'fixup-code))) + +(print 'fixup-depends) + + +;;**************** +;; fixup-substitutions - substitute <var>_reg for <var> for each +;; state variable in code, also substitute var-name for name +;; (this is the depended-on value) +;;**************** +(defun fixup-substitutions (alg code name var-name) + (dolist (state (get-slot alg 'state)) + (let ((var (cadr state))) + (setf code (substitute code var (strcat var "_reg") t)))) + (substitute code name var-name nil)) + +(print 'fixup-substitutions) + + +;;**************** +;; in-min-list - see if name is in TERMINATE MIN list or +;; LOGICAL-STOP MIN list +;; +;; returns true if algorithm specified, say (TERMINATE (MIN s1 s2 s3)) and +;; name is, say, "s2". +;; NOTE: name is a string, so we have to do a lookup to get the symbol name +;;**************** +(defun in-min-list (name alg terminate-or-logical-stop) + (let ((spec (get alg terminate-or-logical-stop))) +; (display "in-min-list" name alg terminate-or-logical-stop spec) + (and spec + (listp (car spec)) + (eq (caar spec) 'MIN) + (member (name-to-symbol name) (cdar spec))))) + + +;;**************** +;; logical-stop-check-needed -- says if we need to check for logical stop +;; after the outer loop +;; the argument is the logical-stop clause from the algorithm prop list +;;**************** +(defun logical-stop-check-needed (logical-stop) + (cond ((and logical-stop + (listp logical-stop) + (or (eq (car logical-stop) 'MIN) + (eq (car logical-stop) 'AT)))))) + + +;;**************** +;; susp-check-fn -- find fn to check need for new block of samples +;; +;; To simply check if susp->S_ptr points to something, you call +;; susp_check_samples(S, S_ptr, S_cnt), but during this check, it is +;; also necessary to check for termination condition and logical stop +;; condition, BUT ONLY if S is in a MIN list for the TERMINATE or +;; LOGICAL-STOP attributes (i.e. this signal stops when S does). +;; +;; The algorithm is: if S is on the LOGICAL-STOP MIN list and on +;; the TERMINATE MIN list, then call susp_check_term_log_samples. +;;Otherwise if S is on the LOGICAL-STOP MIN list then call +;; susp_check_log_samples. Otherwise, if S is on the TERMINATE MIN +;; list, call susp_check_term_samples. The "normal" case should be +;; susp_check_term_samples, which happens when the LOGICAL-STOP +;; MIN list is empty (nothing was specified). Note that a signal logically +;; stops at termination time anyway, so this achieves the logically stopped +;; condition with no checking. +;;**************** +(defun susp-check-fn (name alg) + (let ((in-log-list (in-min-list name alg 'logical-stop)) + (in-term-list (in-min-list name alg 'terminate))) + (cond ((and in-log-list in-term-list) + "susp_check_term_log_samples") + (in-log-list + "susp_check_log_samples") + (in-term-list + "susp_check_term_samples") + (t + "susp_check_samples")))) + + +;;************ +;; write-depend-decls -- declare TEMP depends variables +;; +;;************ +;(defun write-depend-decls (alg stream) +; (dolist (dep (get-slot alg 'depends)) +; (cond ((eq (cadddr dep) 'TEMP) +; (format stream "\t~A ~A; ~%" (car (cddddr dep)) (car dep)))))) +;-------- + +(defun write-depend-decls (alg stream interp sound-names step-function) + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + (method (nth n interp)) + is-step) + (cond ((eq method 'INTERP) + (setf is-step (member (name-to-symbol name) step-function)) + (cond (is-step + (fixup-depends-prime-decls alg stream name)))))))) + + +;;************ +;; write-prime -- write conditional code to prime input sounds and susp +;; +;;************ +(defun write-prime (alg stream interp sound-names) + (let ((step-function (get-slot alg 'step-function)) + (internal-scaling (get-slot alg 'internal-scaling))) + ;------------------------------ + ; /* make sure sounds are primed with first values */ + ;------------------------------ + (format stream "~% /* make sure sounds are primed with first values */~%") + + ;------------------------------ + ; if (!susp->started) { + ; susp->started = true; + ;------------------------------ + + (format stream " if (!susp->started) {~%") + ; this is generating extraneous declarations, is it necessary? + ; yes, at least sometimes, so we're leaving it in + ; "atonev.alg" is a good test case to prove you can't comment this out + (write-depend-decls alg stream interp sound-names step-function) + (format stream "\tsusp->started = true;~%") + + ;------------------------------ + ; for each method + ;------------------------------ + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + (method (nth n interp)) + is-step) + (cond ((eq method 'INTERP) + ;-------------------- + ; susp_XX_samples(NAME, NAME_ptr, NAME_cnt); + ; susp->NAME_x1_sample = susp_fetch_sample(NAME, NAME_ptr, + ; NAME_cnt); + ; <fixup depends variables> (if a step function) + ;-------------------- + (format stream "\t~A(~A, ~A_ptr, ~A_cnt);~%" + (susp-check-fn name alg) name name name) + (cond ((member (name-to-symbol name) internal-scaling) + (format stream + "\tsusp->~A_x1_sample = (susp->~A_cnt--, *(susp->~A_ptr));~%" + name name name)) + (t + (format stream + "\tsusp->~A_x1_sample = susp_fetch_sample(~A, ~A_ptr, ~A_cnt);~%" + name name name name))) + (setf is-step (member (name-to-symbol name) step-function)) + (cond (is-step + (fixup-depends-prime alg stream name "\t" + (strcat "susp->" name "_x1_sample"))))) + ((eq method 'RAMP) + ;-------------------- + ; susp->NAME_pHaSe = 1.0; + ;-------------------- + (format stream "\tsusp->~A_pHaSe = ~A;~%" name "1.0"))))) + + ;-------------------- + ; *WATCH* + ; show_samples(2,susp->NAME_x2,0); + ;-------------------- +; (if *WATCH* +; (format stream "\tshow_samples(2,~A_x2,0);~%" name)) + + ;-------------------- + ; } + ;-------------------- + (format stream " }~%"))) + + +(print 'write-prime) + +;;************ +;; show-samples-option +;; +;; Inputs: +;; stream: output stream for file +;; name: token to use for forming name +;; Effect: +;; Writes sampling clause +;;************ +(defun show-samples-option (stream name) + ;---------------------------- + ; else + ; { /* just show NAME */ + ; show_samples(1,NAME,NAME_ptr - NAME->samples); + ; } /* just show NAME */ + ;---------------------------- +; (format stream "\t show_samples(1, ~A, 0);~%\t} else {~%" name) +; (format stream "\t show_samples(1, ~A, ~A_ptr - ~A->samples);~%~%" +; name name name) +) + + +(print "show-samples-option") + +;;************ +;; write-susp -- compile the suspension according to interpolation spec +;; +;;************ + +(defun write-susp (alg stream) + (let* ((interp (get alg 'interpolation)) + (encoding (encode interp)) + (internal-scaling (get alg 'internal-scaling)) + (sound-names (get alg 'sound-names)) + (name (get-slot alg 'name)) + (logical-stop (car (get-slot alg 'logical-stop))) + (terminate (car (get-slot alg 'terminate))) + (outer-loop (get-slot alg 'outer-loop)) + (step-function (get-slot alg 'step-function)) + (depends (get-slot alg 'depends)) + (inner-loop (get-slot alg 'inner-loop)) + n s m p fn-name loop-prefix joint-depend) + + (display "write-susp" interp encoding) + + ;--------------------------- + ; non-ANSI: + ; void NAME_<encoding>_fetch(susp, snd_list) + ; register pwl_susp_type susp; + ; snd_list_type snd_list; + ; { + ; ANSI: + ; void NAME_<encoding>_fetch(register susp_type susp, snd_list_type snd_list) + ; { + ;--------------------------- + + (setf fn-name (format nil "~A_~A_fetch" name encoding)) + (cond (*ANSI* + (format stream + "~%~%void ~A(register ~A_susp_type susp, snd_list_type snd_list)~%{~%" + fn-name name)) + (t + (format stream + "~%~%void ~A(susp, snd_list)~% register ~A_susp_type susp;~%~A~%" + fn-name name " snd_list_type snd_list;\n{"))) + + ;----------------------------- + ; int cnt = 0; /* how many samples computed */ + ;----------------------------- + (format stream " int cnt = 0; /* how many samples computed */~%") + + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + interpolate-samples + (method (nth n interp))) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + + (cond ((and interpolate-samples (eq method 'INTERP)) + (format stream " sample_type ~A_x2_sample;~%" name)) + ((eq method 'INTERP)) + ((and interpolate-samples (eq method 'RAMP)) + ;----------------- + ; sample_type NAME_DeLtA; + ; sample_type NAME_val; + ;----------------- + (format stream " sample_type ~A_DeLtA;~%" name) + (format stream " sample_type ~A_val;~%" name) + (format stream " sample_type ~A_x2_sample;~%" name)) + ((eq method 'RAMP) + ;----------------- + ; sample_type NAME_val; + ;----------------- + (format stream " sample_type ~A_val;~%" name))))) + + ;----------------------------- + ; int togo; + ; int n; + ; sample_block_type out; + ; register sample_block_values_type out_ptr; + ; register sample_block_values_type out_ptr_reg; + ;----------------------------- + (format stream " int togo;~%") + (format stream " int n;~%") + (format stream " sample_block_type out;~%") + (format stream " register sample_block_values_type out_ptr;~%~%") + (format stream " register sample_block_values_type out_ptr_reg;~%~%") + + ;; computations for DEPENDS variables added to inner loop + (setf loop-prefix "") + (dolist (dep depends) + (dotimes (n (length interp)) + (let ((method (nth n interp)) + (name (nth n sound-names)) + interpolate-samples) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + (cond ((and (equal name (cadr dep)) + (or (member method '(NONE SCALE)) + interpolate-samples)) + (setf loop-prefix (format nil "~A\t ~A = ~A;~%" + loop-prefix (car dep) (caddr dep)))))))) + + ;; computation of JOINT-DEPENDENCY, if applicable + (setf joint-depend "") + (dolist (dep (get-slot alg 'joint-dependency)) + ;; if any depended on var is recomputed in inner loop, add the stmts + (cond ((depended-on-in-inner-loop (car dep) interp sound-names + step-function) + (dolist (stmt (cdr dep)) + (setf joint-depend (strcat joint-depend + "\t " stmt "\n")))))) + + ; this computes some additional declarations + (compute-inner-loop alg (strcat loop-prefix joint-depend inner-loop)) + ; make the declarations + (print-strings (get-slot alg 'register-decl) stream) + + ;----------------------------- + ; falloc_sample_block(out, "caller"); + ; out_ptr = out->samples; + ; snd_list->block = out; + ;----------------------------- + (format stream " falloc_sample_block(out, \"~A\");~%" fn-name) + (format stream " out_ptr = out->samples;~%") + (format stream " snd_list->block = out;~%") + + ;----------------------------- + ; prime the ramp/interp streams + ;----------------------------- + ;; run this code the first time the suspension is called + (cond ((or (member 'RAMP interp) (member 'INTERP interp)) + (write-prime alg stream interp sound-names))) + + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + interpolate-samples + (method (nth n interp))) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + + (cond ((or (and interpolate-samples (eq method 'INTERP)) + (eq method 'RAMP)) + ;------------- + ; susp_check_XX_samples(NAME, NAME_ptr, NAME_cnt); + ;------------- + (format stream + "~% ~A(~A, ~A_ptr, ~A_cnt);~%" + (susp-check-fn name alg) name name name))) + + (cond ((and interpolate-samples (eq method 'INTERP)) + ;------------- + ; susp->NAME_x2_sample = susp->NAME->scale * susp->NAME_x2_ptr); + ;------------- + (cond ((member (name-to-symbol name) internal-scaling) + (format stream + " ~A_x2_sample = *(susp->~A_ptr);~%" name name)) + (t + (format stream + " ~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%" + name name name)))) + ((eq method 'INTERP) + ;------------- + ; + ;------------- + ) + ((and interpolate-samples (eq method 'RAMP)) + ;---------------- + ; susp->NAME_x2_sample = susp_current_sample(NAME, NAME_ptr); + ;---------------- + (cond ((member (name-to-symbol name) internal-scaling) + (format stream + " ~A_x2_sample = *(susp->~A_ptr);~%" name name)) + (t + (format stream + " ~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%" + name name name)))) + ((eq method 'RAMP) + )))) + + ;---------------------------- + ; *WATCH*: printf("NAME %x new block %x\n", susp, out); + ;---------------------------- + (if *watch* + (format stream " printf(\"~A %x new block %x\\n\", susp, out);~%" name)) + + ;---------------------------- + ; 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; + ;---------------------------- + + (format stream + "~% while (cnt < max_sample_block_len) { /* outer loop */~%") + (format stream + "\t/* first compute how many samples to generate in inner loop: */~%") + (format stream + "\t/* don't overflow the output sample block: */~%") + (format stream + "\ttogo = max_sample_block_len - cnt;~%~%") + + ;; this loop gets ready to execute the INNER-LOOP + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + interpolate-samples + (method (nth n interp))) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + + (cond ((member method '(NONE SCALE)) + ;----------------- + ; NONE: + ; /* don't run past the NAME input sample block */ + ; susp_check_XX_for_samples(NAME, NAME_ptr, NAME_cnt); + ; togo = min(togo, susp->NAME_cnt); + ;----------------- + (format stream + "\t/* don't run past the ~A input sample block: */~%" name) + (display "don't run past the ..." name (susp-check-fn name alg)) + (format stream + "\t~A(~A, ~A_ptr, ~A_cnt);~%" + (susp-check-fn name alg) name name name) + (format stream "\ttogo = min(togo, susp->~A_cnt);~%~%" name)) + ((eq method 'INTERP)) + ((and interpolate-samples (eq method 'RAMP)) + ;----------------- + ; RAMP: + ; + ; /* grab next NAME_x2_sample when phase goes past 1.0 */ + ; /* we use NAME_n (computed below) to avoid roundoff errors: */ + ; if (susp->NAME_n <= 0) { + ; susp->NAME_x1_sample = NAME_x2_sample; + ; susp->NAME_ptr++; + ; susp_took(NAME_cnt, 1); + ; susp->NAME_pHaSe -= 1.0; + ; susp_check_log_samples(NAME, NAME_ptr, NAME_cnt); + ; NAME_x2_sample = susp_current_sample(NAME, NAME_ptr); + ; } + ; /* NAME_n gets number of samples before phase exceeds 1.0: */ + ; susp->NAME_n = 0.5 + (long) ((1.0 - susp->NAME_pHaSe) * susp->output_per_NAME); + ; togo = min(togo, susp->NAME_n); + ; NAME_DeLtA = (sample_type) ((NAME_x2_sample - susp->NAME_x1_sample) * susp->NAME_pHaSe_iNcR); + ; NAME_val = (sample_type) (susp->NAME_x1_sample * (1.0 - susp->NAME_pHaSe) + + ; NAME_x2_sample * susp->NAME_pHaSe); + ;----------------- + (format stream + "\t/* grab next ~A_x2_sample when phase goes past 1.0; */~%" name) + (format stream + "\t/* we use ~A_n (computed below) to avoid roundoff errors: */~%" name) + (format stream "\tif (susp->~A_n <= 0) {~%" name) + (format stream "\t susp->~A_x1_sample = ~A_x2_sample;~%" + name name) + (format stream "\t susp->~A_ptr++;~%" name); + (format stream "\t susp_took(~A_cnt, 1);~%" name); + (format stream "\t susp->~A_pHaSe -= 1.0;~%" name); + (format stream "\t ~A(~A, ~A_ptr, ~A_cnt);~%" + (susp-check-fn name alg) name name name) + (cond ((member (name-to-symbol name) internal-scaling) + (format stream + "\t ~A_x2_sample = *(susp->~A_ptr);~%" name name)) + (t + (format stream + "\t ~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%" + name name name))) + (format stream + "\t /* ~A_n gets number of samples before phase exceeds 1.0: */~%" + name) + (format stream + "\t susp->~A_n = (long) ((1.0 - susp->~A_pHaSe) *~%" + name name) + (format stream "\t\t\t\t\tsusp->output_per_~A);~%\t}~%" name) + (format stream "\ttogo = min(togo, susp->~A_n);~%" name) + (format stream "\t~A_DeLtA = (sample_type) ((~A_x2_sample - susp->~A_x1_sample) * susp->~A_pHaSe_iNcR);~%" + name name name name) + (format stream + "\t~A_val = (sample_type) (susp->~A_x1_sample * (1.0 - susp->~A_pHaSe) +~%" + name name name) + (format stream "\t\t ~A_x2_sample * susp->~A_pHaSe);~%~%" + name name)) + ((eq method 'RAMP) + ;----------------- + ; SLOW STEP FUNCTION + ; + ; /* grab next NAME_x1_sample when phase goes past 1.0 */ + ; /* use NAME_n (computed below) to avoid roundoff errors: */ + ; if (susp->NAME_n <= 0) { + ; <fixup depends declarations> + ; susp_check_log_samples(NAME, NAME_ptr, NAME_cnt); + ; susp->NAME_x1_sample = susp_fetch_sample(NAME, NAME_ptr, + ; NAME_cnt); + ; susp->NAME_pHaSe -= 1.0; + ; /* NAME_n gets number of samples before phase + ; exceeds 1.0: */ + ; susp->NAME_n = (long) ((1.0 - susp->NAME_pHaSe) * + ; susp->output_per_NAME); + ; <fixup depends variables> + ; } + ; togo = min(togo, susp->NAME_n); + ; NAME_val = susp->NAME_x1_sample; + ;----------------- + (format stream + "\t/* grab next ~A_x1_sample when phase goes past 1.0; */~%" + name) + (format stream + "\t/* use ~A_n (computed below) to avoid roundoff errors: */~%" + name) + (format stream "\tif (susp->~A_n <= 0) {~%" name) + (fixup-depends-prime-decls alg stream name) + (format stream "\t ~A(~A, ~A_ptr, ~A_cnt);~%" + (susp-check-fn name alg) name name name) + (format stream + "\t susp->~A_x1_sample = susp_fetch_sample(~A, ~A_ptr, ~A_cnt);~%" + name name name name) + (format stream "\t susp->~A_pHaSe -= 1.0;~%" name); + (format stream + "\t /* ~A_n gets number of samples before phase exceeds 1.0: */~%" + name) + (format stream + "\t susp->~A_n = (long) ((1.0 - susp->~A_pHaSe) *~%" + name name) + (format stream "\t\t\t\t\tsusp->output_per_~A);~%" name) + (fixup-depends-prime alg stream name "\t " + (strcat "susp->" name "_x1_sample")) + (format stream "\t}~%" name) + (format stream "\ttogo = min(togo, susp->~A_n);~%" name) + (format stream + "\t~A_val = susp->~A_x1_sample;~%" name name) )))) + + ;--------------- + ; see if there are joint-dependencies that should be output now + ; output here if none of depended-on signals are updated in inner loop + ;--------------- + ;; computation of JOINT-DEPENDENCY, if applicable + (setf joint-depend "") + (dolist (dep (get-slot alg 'joint-dependency)) + (cond ((not (depended-on-in-inner-loop (car dep) interp sound-names + step-function)) + (dolist (stmt (cdr dep)) + (setf joint-depend (strcat joint-depend + "\t" stmt "\n")))))) + (display "joint-depend before fixup" joint-depend) + (setf joint-depend (fixup-substitutions-for-depends alg joint-depend)) + (if joint-depend (format stream joint-depend)) + (display "joint-depend outside loop" joint-depend) + + ;---------------- + ; if the teminate time is a MIN of some signals or AT some expression + ; (i.e. specified at all) see if we're coming to the terminate cnt: + ; + ; /* don't run past terminate time */ + ; if (susp->terminate_cnt != UNKNOWN && + ; susp->terminate_cnt <= susp->susp.current) { + ; int to_stop = (susp->terminate_cnt + max_sample_block_len) - + ; (susp->susp.current + cnt); + ; if (to_stop < togo && ((togo = to_stop) == 0)) break; + ; } + ;---------------- + (cond ((terminate-check-needed terminate alg) + (print-strings '( + "\t/* don't run past terminate time */\n" + "\tif (susp->terminate_cnt != UNKNOWN &&\n" + "\t susp->terminate_cnt <= susp->susp.current + cnt + togo) {\n" + "\t togo = susp->terminate_cnt - (susp->susp.current + cnt);\n" + "\t if (togo == 0) break;\n" + "\t}\n\n") stream))) + + ;---------------- + ; if the logical-stop attribute is MIN of some signals or AT some expression + ; see if we're coming to the logical stop: + ; + ; /* 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; + ; } + ; } + ;---------------- + (cond (logical-stop + (print-strings '( + "\n\t/* don't run past logical stop time */\n" + "\tif (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) {\n" + "\t int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt);\n" + "\t /* break if to_stop == 0 (we're at the logical stop)\n" + "\t * AND cnt > 0 (we're not at the beginning of the\n" + "\t * output block).\n" + "\t */\n" + "\t if (to_stop < togo) {\n" + "\t\tif (to_stop == 0) {\n" + "\t\t if (cnt) {\n" + "\t\t\ttogo = 0;\n" + "\t\t\tbreak;\n" + "\t\t } else /* keep togo as is: since cnt == 0, we\n" + "\t\t * can set the logical stop flag on this\n" + "\t\t * output block\n" + "\t\t */\n" + "\t\t\tsusp->logically_stopped = true;\n" + "\t\t} else /* limit togo so we can start a new\n" + "\t\t * block at the LST\n" + "\t\t */\n" + "\t\t togo = to_stop;\n" + "\t }\n" + "\t}\n\n") + stream))) + + (cond (outer-loop + (print-strings outer-loop stream) + (format stream "~%"))) + + ;---------------------------- + ; n = togo; + ; *WATCH*: printf("ALG %x starting inner loop, n %d\n", susp, n); + ;---------------------------- + + (format stream "\tn = togo;~%") + (if *watch* + (format stream + "\tprintf(\"~A %x starting inner loop, n %d\\n\", susp, n);~%" + name)) + + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + (method (nth n interp))) + (cond ((eq method 'NONE)) + ;----------------- + ; NONE: + ;----------------- + ((eq method 'RAMP)) + ;----------------- + ; RAMP: + ;----------------- + ((and (eq method 'INTERP) (eq n 0)) + ;----------------- + ; INTERP (first arg only) +; ; susp->NAME_cnt -= togo; + ;----------------- +; (format stream "\tsusp->~A_cnt -= togo;~%" name) + )))) + + (print-strings (get-slot alg 'register-init) stream) + ;---------------------------- + ; if (n) do { /* inner loop */ + ;---------------------------- + + (format stream + "\tif (n) do { /* the inner sample computation loop */~%") + + ;;---------------------------- + ;; write local declarations supplied by user + ;;---------------------------- + + (print-strings (get-slot alg 'inner-loop-locals) stream) + + ;;---------------------------- + ;; declare temps that depend on signals + ;;---------------------------- + + (dotimes (n (length interp)) + (let ((method (nth n interp)) + interpolate-samples + (name (nth n sound-names))) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + (cond ((or (member method '(NONE SCALE)) + interpolate-samples) + (dolist (dep depends) + (cond ((and (equal (cadr dep) name) + (eq (cadddr dep) 'TEMP)) + (format stream "\t ~A ~A;~%" (car (cddddr dep)) + (car dep))))))))) + + ;; this loop writes code that runs in the INNER-LOOP and checks to see + ;; if we need to advance to the next pair of interpolated points for + ;; each interpolated sound + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + interpolate-samples + (method (nth n interp))) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + + (cond ((and interpolate-samples (eq method 'INTERP)) + ;----------------- + ; INTERP: + ; + ; if (susp->NAME_pHaSe >= 1.0) { + ; NAME_x1_sample_reg =NAME_x2_sample_reg; + ; /* pick up next sample as NAME_x2_sample */ + ; susp->NAME_ptr++; + ; susp_took(NAME_cnt, 1); + ; susp->NAME_pHaSe -= 1.0; + ; susp_check_XX_samples_break(NAME, NAME_ptr, NAME_cnt, NAME_x2_sample); + ; } + ; <maintenance of depends variables> + ;----------------- + (format stream "\t if (~A_pHaSe_ReG >= 1.0) {~%" name) + (format stream "\t\t~A_x1_sample_reg = ~A_x2_sample;~%" + name name) + (format stream "\t\t/* pick up next sample as ~A_x2_sample: */~%" name) + (format stream "\t\tsusp->~A_ptr++;~%" name) + (format stream "\t\tsusp_took(~A_cnt, 1);~%" name) + (format stream "\t\t~A_pHaSe_ReG -= 1.0;~%" name) + (format stream "\t\t~A_break(~A, ~A_ptr, ~A_cnt, ~A_x2_sample);~%" + (susp-check-fn name alg) name name name name) +; (format stream "\t\t~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%" +; name name name) + + ; show_samples(2, susp->NAME_x2, susp->NAME_x2_ptr - + ; NAME_x2->block->samples); + ;----------------- + +; (if *WATCH* +; (format stream "\t\tshow_samples(2,susp->~A_x2,susp->~A_x2_ptr - susp->~A_x2->block->samples);~%" +; name name name) +; ) + ;----------------- + ; } + ;----------------- + (format stream "\t }~%") + ) + ((eq method 'INTERP) + ;----------------- + ; STEP FUNCTION: + ; + ; if (susp->NAME_pHaSe >= 1.0) { + ; <optional depends/fixup declarations> + ; /* pick up next sample as NAME_x1_sample */ + ; susp->NAME_ptr++; + ; susp_took(NAME_cnt, 1); + ; susp->NAME_pHaSe -= 1.0; + ; susp_check_XX_samples_break(NAME, NAME_ptr, NAME_cnt, NAME_x1_sample); + ; NAME_x1_sample_reg = susp_current_sample(NAME, NAME_ptr); + ; <optional depends/fixup code> + ; } + ;----------------- + (format stream "\t if (~A_pHaSe_ReG >= 1.0) {~%" name) + (fixup-depends alg stream name) + (format stream "\t\t/* pick up next sample as ~A_x1_sample: */~%" name) + (format stream "\t\tsusp->~A_ptr++;~%" name) + (format stream "\t\tsusp_took(~A_cnt, 1);~%" name) + (format stream "\t\t~A_pHaSe_ReG -= 1.0;~%" name) + (format stream "\t\t~A_break(~A, ~A_ptr, ~A_cnt, ~A_x1_sample_reg);~%" + (susp-check-fn name alg) name name name name) + (format stream "\t\t~A_x1_sample_reg = susp_current_sample(~A, ~A_ptr);~%" + name name name) + + ; show_samples(2, susp->NAME_x2, susp->NAME_x2_ptr - + ; NAME_x2->block->samples); + ;----------------- + +; (if *WATCH* +; (format stream "\t\tshow_samples(2,susp->~A_x2,susp->~A_x2_ptr - susp->~A_x2->block->samples);~%" +; name name name) +; ) + (let ((fixup-code (get-slot alg 'fixup-code))) + (if fixup-code (format stream fixup-code))) + + ;----------------- + ; } + ;----------------- + (format stream "\t }~%"))))) + + (write-inner-loop alg stream) + (print-strings (get-slot alg 'register-cleanup) stream) + + ;; this loop calls loop tail computations on all sounds + (dotimes (n (length interp)) + (let ((name (nth n sound-names)) + interpolate-samples + (method (nth n interp))) + (setf interpolate-samples + (not (member (name-to-symbol name) step-function))) + + (cond ((member method '(NONE SCALE)) + ;----------------- + ; NONE: + ; susp_took(NAME_cnt, togo - n); + ;----------------- + (format stream "\tsusp_took(~A_cnt, togo);~%" name)) + ((eq method 'INTERP)) + ((eq method 'RAMP) + ;----------------- + ; RAMP: + ; susp->NAME_pHaSe += togo * susp->NAME_pHaSe_iNcR; + ; susp->NAME_n -= togo; + ;----------------- + (format stream + "\tsusp->~A_pHaSe += togo * susp->~A_pHaSe_iNcR;~%" + name name) + (format stream "\tsusp->~A_n -= togo;~%" name) + )))) + ;----------------------------- + ; cnt += togo; + ; } /* outer loop */ + ; + ; snd_list->block_len = cnt; + ;----------------------------- + + (format stream "~A~%~A~%~%" "\tcnt += togo;" + " } /* outer loop */") + ;----------------------------- + ; if terminate is not NONE (infinite), check for it as follows: + ; /* test for termination */ + ; if (togo == 0 && cnt == 0) { + ; snd_list_terminate(snd_list); + ; *WATCH*: printf("NAME %x terminated\n", susp); + ; } else { + ; snd_list->block_len = cnt; + ; susp->susp.current += cnt; + ; } + ;----------------------------- + (cond ((terminate-possible terminate alg) + (print-strings '( + " /* test for termination */\n" + " if (togo == 0 && cnt == 0) {\n" + "\tsnd_list_terminate(snd_list);\n") + stream) + (if *watch* + (format stream "\tprintf(\"~A %x terminated.\\n\", susp);~%" name)) + (print-strings '( + " } else {\n" + "\tsnd_list->block_len = cnt;\n" + "\tsusp->susp.current += cnt;\n" + " }\n") stream)) + (t + ;---------------- + ; OTHERWISE (no termination test): + ; snd_list->block_len = cnt; + ; susp->susp.current += cnt; + ;---------------- + (print-strings '( + " snd_list->block_len = cnt;\n" + " susp->susp.current += cnt;\n") stream))) + + ;---------------- + ; if logical-stop is not the default check for it as follows: + ; /* 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; + ; } + ;---------------- + (cond ((logical-stop-check-needed logical-stop) + (print-strings '( + " /* test for logical stop */\n" + " if (susp->logically_stopped) {\n" + "\tsnd_list->logically_stopped = true;\n" + " } else if (susp->susp.log_stop_cnt == susp->susp.current) {\n" + "\tsusp->logically_stopped = true;\n" + " }\n") stream))) + + ;---------------- + ; } /* name_encoding_fetch */ + ;---------------- + (format stream "} /* ~A_~A_fetch */~%" name encoding))) + +(print 'write-susp) + +; terminate-check-needed -- see if this is either a terminate clause +; that specifies MIN or AT, or is NIL (meaning none-specified so take +; the default) and there are signal parameters +; +(defun terminate-check-needed (terminate alg) + (cond (terminate + (cond ((listp terminate) + (cond ((member (car terminate) '(MIN AT AFTER)) t) + (t nil))) + ((member terminate '(COMPUTED NONE)) nil) + (t + (error "TERMINATE clause should specify a list")))) + ((get alg 'sound-args) t))) + + +; same as terminate-check-needed, but also returns true for COMPUTED +; termination +; +(defun terminate-possible (terminate alg) + (cond (terminate + (cond ((listp terminate) + (cond ((member (car terminate) '(MIN AT AFTER COMPUTED)) t) + (t nil))) + ((eq terminate 'NONE) nil) + ((eq terminate 'COMPUTED) t) + (t + (error "TERMINATE clause should specify a list")))) + ((get alg 'sound-args) t))) diff --git a/tran/writetoss.lsp b/tran/writetoss.lsp new file mode 100644 index 0000000..acc8e0a --- /dev/null +++ b/tran/writetoss.lsp @@ -0,0 +1,85 @@ +;; writetoss -- writes the "toss prepended samples" routine + +;; modified May 3, 1999 by RBD to not adjust t0 when samples will be tossed +;; also, final_time is just susp->susp.t0, since t0 is unadjusted. + +(defun write-toss (alg stream) + (let ((alg-name (get alg 'name)) + (sound-names (get alg 'sound-names))) + ;;---------------- + ;; void ALG_toss_fetch(susp, snd_list) + ;; register ALG_susp_type susp; + ;; snd_list_type snd_list; + ;; { + ;; long final_count = susp->susp.toss_cnt); + ;; time_type final_time = susp->susp.t0; + ;; FORMERLY, THIS WAS: + ;; time_type final_time = susp->susp.t0 + final_count / susp->susp.sr; + ;; long n; + ;;---------------- + (format stream "~%~%void ~A_toss_fetch(susp, snd_list)~%" alg-name) + (format stream " register ~A_susp_type susp;~%" alg-name) + (format stream " snd_list_type snd_list;~%{~%") + (format stream + " long final_count = susp->susp.toss_cnt;~%") + (format stream +" time_type final_time = susp->susp.t0;~%") + (format stream " long n;~%~%") + + (cond (*watch* + (format stream + " printf(\"~A_toss_fetch: final count %d final time %d\\n\", " + alg-name) + (format stream "final_count, final_time);~%"))) + + ;;------------------------------ + ;; for each sound argument: + ;; + ;; /* fetch samples from NAME up to final_time for this block of zeros */ + ;; while ((round((final_time - susp->NAME->t0) * susp->NAME->sr)) >= + ;; susp->NAME->current) + ;; susp_get_samples(NAME, NAME_ptr, NAME_cnt); + ;;------------------------------ + (dolist (name sound-names) + (format stream + " /* fetch samples from ~A up to final_time for this block of zeros */~%" + name) + (format stream + " while ((round((final_time - susp->~A->t0) * susp->~A->sr)) >=~%" + name name) + (format stream "\t susp->~A->current)~%" name) + (format stream "\tsusp_get_samples(~A, ~A_ptr, ~A_cnt);~%" + name name name)) + + ;;---------------- + ;; /* convert to normal processing when we hit final_count */ + ;; /* we want each signal positioned at final_time */ + ;;---------------- + (format stream + " /* convert to normal processing when we hit final_count */~%") + (format stream " /* we want each signal positioned at final_time */~%") + + ;;---------------- + ;; for each sound argument: + ;; + ;; n = round((final_time - susp->NAME->t0) * susp->NAME->sr - + ;; (susp->NAME->current - susp->NAME_cnt)); + ;; susp->NAME_ptr += n; + ;; susp_took(NAME_cnt, n); + ;;---------------- + (dolist (name sound-names) + (format stream " n = round((final_time - susp->~A->t0) * susp->~A->sr -~%" + name name) + (format stream " (susp->~A->current - susp->~A_cnt));~%" + name name) + (format stream " susp->~A_ptr += n;~%" name) + (format stream " susp_took(~A_cnt, n);~%" name)) + + ;;---------------- + ;; susp->susp.fetch = susp->susp.keep_fetch; + ;; (*(susp->susp.fetch))(susp, snd_list); + ;; } + ;;---------------- + (format stream " susp->susp.fetch = susp->susp.keep_fetch;~%") + (format stream " (*(susp->susp.fetch))(susp, snd_list);~%") + (format stream "}~%"))) |