|
- /* tie CLM module into Scheme, Ruby, or Forth */
-
- /* if the optimizer stops working inexplicably, look for any symbols used before this that
- * might shadow a generator name; one such case was (make-hook 'env...) in snd-env.c
- *
- * (env env) is accepted by the optimizer in error
- */
-
- #include "mus-config.h"
-
- #if USE_SND
- #include "snd.h"
- #endif
-
- #include <stddef.h>
- #include <math.h>
- #include <stdio.h>
- #include <errno.h>
- #include <stdlib.h>
- #include <limits.h>
- #include <string.h>
- #include <stdarg.h>
-
- #ifndef _MSC_VER
- #include <unistd.h>
- #else
- #include <io.h>
- #pragma warning(disable: 4244)
- #endif
-
- #include "_sndlib.h"
- #include "xen.h"
- #include "clm.h"
- #include "sndlib2xen.h"
- #include "vct.h"
- #include "clm2xen.h"
- #include "clm-strings.h"
-
- #ifndef TWO_PI
- #define TWO_PI (2.0 * M_PI)
- #endif
-
- #ifndef PROC_FALSE
- #if HAVE_RUBY
- #define PROC_FALSE "false"
- #define PROC_TRUE "true"
- #else
- #define PROC_FALSE "#f"
- #define PROC_TRUE "#t"
- #endif
- #endif
-
-
- /* -------------------------------------------------------------------------------- */
- #if HAVE_SCHEME
- static bool mus_simple_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO)
- {
- rdout *gen = (rdout *)IO;
- if ((chan < gen->chans) &&
- (samp <= gen->data_end) &&
- (samp >= gen->data_start))
- {
- gen->obufs[chan][samp - gen->data_start] += val;
- if (samp > gen->out_end)
- gen->out_end = samp;
- return(true);
- }
- return(false);
- }
- #endif
-
- /* -------------------------------------------------------------------------------- */
-
- struct mus_xen {
- mus_any *gen;
- int nvcts;
- #if HAVE_SCHEME
- bool free_data;
- #endif
- Xen *vcts; /* one for each accessible mus_float_t array (wrapped up here in a vct) */
- struct mus_xen *next;
- };
-
-
- enum {MUS_DATA_WRAPPER, MUS_INPUT_FUNCTION, MUS_ANALYZE_FUNCTION, MUS_EDIT_FUNCTION, MUS_SYNTHESIZE_FUNCTION, MUS_SAVED_FUNCTION,
- MUS_SELF_WRAPPER, MUS_INPUT_DATA, MUS_MAX_VCTS}; /* order matters, stuff before self_wrapper is GC marked */
-
- static mus_xen *mx_free_lists[9] = {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL};
-
- static mus_xen *mx_alloc(int vcts)
- {
- mus_xen *p;
- if (mx_free_lists[vcts])
- {
- p = mx_free_lists[vcts];
- mx_free_lists[vcts] = p->next;
- return(p);
- }
- p = (mus_xen *)malloc(sizeof(mus_xen));
- p->nvcts = vcts;
- if (vcts > 0)
- p->vcts = (Xen *)malloc(vcts * sizeof(Xen));
- else p->vcts = NULL;
- #if HAVE_SCHEME
- p->free_data = false;
- #endif
- return(p);
- }
-
-
- static void mx_free(mus_xen *p)
- {
- #if HAVE_SCHEME
- if (p->free_data)
- {
- s7_xf_attach(s7, (void *)(p->vcts[MUS_INPUT_DATA]));
- p->free_data = false;
- }
- #endif
- p->next = mx_free_lists[p->nvcts];
- mx_free_lists[p->nvcts] = p;
- }
-
-
- mus_any *mus_xen_gen(mus_xen *x) {return(x->gen);}
- #define mus_xen_to_mus_any(Gn) (((mus_xen *)Gn)->gen)
-
- #if (!HAVE_SCHEME)
- #define XEN_NULL 0
-
- #define Xen_real_to_C_double_if_bound(Xen_Arg, C_Val, Caller, ArgNum) \
- if (Xen_is_bound(Xen_Arg)) {if (Xen_is_number(Xen_Arg)) C_Val = Xen_real_to_C_double(Xen_Arg); else Xen_check_type(false, Xen_Arg, ArgNum, Caller, "a number");}
-
- #define Xen_to_C_double_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
- do {C_Val = 0.0; if (Xen_is_number(Xen_Arg)) C_Val = Xen_real_to_C_double(Xen_Arg); else Xen_check_type(false, Xen_Arg, ArgNum, Caller, "a number");} while (0)
-
- #define Xen_real_to_C_double_with_caller(Xen_Arg, Caller) Xen_real_to_C_double(Xen_Arg)
-
- #define Xen_to_C_integer_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
- do {if (Xen_is_integer(Xen_Arg)) C_Val = Xen_integer_to_C_int(Xen_Arg); else {C_Val = 0.0; Xen_check_type(false, Xen_Arg, ArgNum, Caller, "an integer");}} while (0)
-
- #if (HAVE_FORTH) || (HAVE_RUBY)
- #define Xen_object_ref_checked(Obj, Type) (Xen_c_object_is_type(Obj, Type) ? Xen_object_ref(Obj) : NULL)
- #else
- #define Xen_object_ref_checked(Obj, Type) NULL
- #endif
-
- #else
- #define Xen_real_to_C_double_if_bound(Xen_Arg, C_Val, Caller, ArgNum) if (Xen_is_bound(Xen_Arg)) C_Val = (double)s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
- #define Xen_to_C_double_or_error(Xen_Arg, C_Val, Caller, ArgNum) C_Val = (double)s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
- #define Xen_real_to_C_double_with_caller(Xen_Arg, Caller) s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
-
- #define Xen_to_C_integer_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
- do {if (s7_is_integer(Xen_Arg)) C_Val = s7_integer(Xen_Arg); else {C_Val = 0.0; Xen_check_type(false, Xen_Arg, ArgNum, Caller, "an integer");}} while (0)
-
- #define Xen_object_ref_checked(Obj, Type) s7_object_value_checked(Obj, Type)
- #define XEN_NULL NULL
- #endif
-
-
- static int local_error_type = MUS_NO_ERROR;
- static char *local_error_msg = NULL;
-
- static void local_mus_error(int type, char *msg)
- {
- local_error_type = type;
- if (local_error_msg) free(local_error_msg);
- local_error_msg = mus_strdup(msg);
- }
-
-
- static Xen clm_mus_error(int type, const char *msg, const char *caller)
- {
- /* mus_error returns an int, which is a bother in this context */
- mus_error(type, "%s: %s", caller, msg);
- return(Xen_false);
- }
-
-
- #define CLM_ERROR Xen_make_error_type("mus-error")
-
- static void clm_error(const char *caller, const char *msg, Xen val)
- {
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: ~A ~A"),
- C_string_to_Xen_string(caller),
- C_string_to_Xen_string(msg),
- val));
- }
-
-
-
- /* ---------------- optional-key ---------------- */
-
- int mus_optkey_unscramble(const char *caller, int nkeys, Xen *keys, Xen *args, int *orig)
- {
- /* implement the &optional-key notion in CLM */
- /* "keys" holds the keywords the calling function accepts,
- * upon return, if a key was given in the arglist or its position had a value, the corresponding value is in its keys location
- * "nkeys is the size of "keys"
- * "args" contains the original arguments passed to the function in order
- * it should be of size nkeys * 2, and any trailing (unspecified) args should be Xen_undefined
- * "orig" should be of size nkeys, and will contain upon return the 1-based location of the original keyword value argument
- * (it is intended for error reports)
- */
- int arg_ctr = 0, key_start = 0, rtn_ctr = 0, nargs, nargs_end;
- bool keying = false, key_found = false;
- nargs = nkeys * 2;
- nargs_end = nargs - 1;
-
- while ((arg_ctr < nargs) &&
- (Xen_is_bound(args[arg_ctr])))
- {
- Xen key;
- key = args[arg_ctr];
- if (!(Xen_is_keyword(key)))
- {
- if (keying)
- clm_error(caller, "unmatched value within keyword section?", key);
- /* type checking on the actual values has to be the caller's problem */
-
- if (arg_ctr >= nkeys) /* we aren't handling a keyword arg, so the underlying args should only take nkeys args */
- clm_error(caller, "extra trailing args?", key);
-
- keys[arg_ctr] = key;
- orig[arg_ctr] = arg_ctr + 1;
- arg_ctr++;
- key_start = arg_ctr;
- rtn_ctr++;
- }
- else
- {
- int i;
- Xen val;
- val = args[arg_ctr + 1];
- if ((arg_ctr == nargs_end) ||
- (!(Xen_is_bound(val))))
- clm_error(caller, "keyword without value?", key);
-
- if (Xen_is_keyword(val))
- clm_error(caller, "two keywords in a row?", key);
-
- keying = true;
- key_found = false;
- for (i = key_start; i < nkeys; i++)
- {
- if (Xen_keyword_is_eq(keys[i], key))
- {
- keys[i] = val;
- arg_ctr += 2;
- orig[i] = arg_ctr;
- rtn_ctr++;
- key_found = true;
- break;
- }
- }
-
- if (!key_found)
- {
- /* either there's a redundant keyword pair or a keyword that 'caller' doesn't recognize */
- clm_error(caller, "redundant or invalid key found", key);
- /* normally (all local cases) the error returns */
- arg_ctr += 2;
- }
- }
- }
- return(rtn_ctr);
- }
-
-
- static mus_float_t optkey_float_error(Xen key, int n, const char *caller)
- {
- Xen_check_type(false, key, n, caller, "a number");
- return(0.0);
- }
-
- #define Xen_optkey_to_float(Original_key, Key, Caller, N, Def) \
- ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_number(Key)) ? Xen_real_to_C_double(Key) : optkey_float_error(Key, N, Caller)))
-
- mus_float_t mus_optkey_to_float(Xen key, const char *caller, int n, mus_float_t def)
- {
- if (Xen_is_number(key))
- return(Xen_real_to_C_double(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "a number");
- return(def);
- }
-
-
- static int optkey_int_error(Xen key, int n, const char *caller)
- {
- Xen_check_type(false, key, n, caller, "an integer");
- return(0);
- }
-
- #define Xen_optkey_to_int(Original_key, Key, Caller, N, Def) \
- ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_integer(Key)) ? Xen_integer_to_C_int(Key) : optkey_int_error(Key, N, Caller)))
-
- int mus_optkey_to_int(Xen key, const char *caller, int n, int def)
- {
- if (Xen_is_integer(key))
- return(Xen_integer_to_C_int(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "an integer");
- return(def);
- }
-
-
- bool mus_optkey_to_bool(Xen key, const char *caller, int n, bool def)
- {
- if (Xen_is_boolean(key))
- return(Xen_boolean_to_C_bool(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "#f or #t");
- return(def);
- }
-
-
- static mus_long_t optkey_llong_error(Xen key, int n, const char *caller)
- {
- Xen_check_type(false, key, n, caller, "an integer");
- return(0);
- }
-
- #define Xen_optkey_to_mus_long_t(Original_key, Key, Caller, N, Def) \
- ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_integer(Key)) ? Xen_llong_to_C_llong(Key) : optkey_llong_error(Key, N, Caller)))
-
- mus_long_t mus_optkey_to_mus_long_t(Xen key, const char *caller, int n, mus_long_t def)
- {
- if (Xen_is_integer(key))
- return(Xen_llong_to_C_llong(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "a sample number or size");
- return(def);
- }
-
-
- const char *mus_optkey_to_string(Xen key, const char *caller, int n, char *def)
- {
- if (Xen_is_string(key))
- return(Xen_string_to_C_string(key));
- if ((!(Xen_is_keyword(key))) && (!(Xen_is_false(key))))
- Xen_check_type(false, key, n, caller, "a string");
- return(def);
- }
-
-
- static vct *mus_optkey_to_vct(Xen key, const char *caller, int n, vct *def)
- {
- if (mus_is_vct(key))
- return(Xen_to_vct(key));
- if ((!(Xen_is_keyword(key))) && (!(Xen_is_false(key))))
- Xen_check_type(false, key, n, caller, "a " S_vct);
- return(def);
- }
-
-
- static bool local_arity_ok(Xen proc, int args) /* from snd-xen.c minus (inconvenient) gc protection */
- {
- #if HAVE_SCHEME
- return(s7_is_aritable(s7, proc, args));
- #else
- Xen arity;
- int rargs;
- arity = Xen_arity(proc);
- rargs = Xen_integer_to_C_int(arity);
-
- #if HAVE_RUBY
- return(xen_rb_arity_ok(rargs, args));
- #endif
-
- #if HAVE_FORTH
- return(rargs == args);
- #endif
- #endif
- return(true);
- }
-
-
- Xen mus_optkey_to_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err)
- {
- /* in this case, it's faster to look for the keyword first */
- if ((!(Xen_is_keyword(key))) &&
- (!(Xen_is_false(key))))
- {
- Xen_check_type(Xen_is_procedure(key), key, n, caller, "a procedure");
- if (!(local_arity_ok(key, required_args)))
- Xen_bad_arity_error(caller, n, key, err);
- return(key);
- }
- return(def);
- }
-
-
-
- /* ---------------- clm keywords ---------------- */
-
- static Xen kw_frequency, kw_initial_phase, kw_wave, kw_amplitude,
- kw_r, kw_ratio, kw_size, kw_a0, kw_a1, kw_a2, kw_b1, kw_b2, kw_max_size,
- kw_input, kw_srate, kw_file, kw_channel, kw_start,
- kw_initial_contents, kw_initial_element, kw_scaler, kw_feedforward, kw_feedback,
- kw_radius, kw_partials, kw_a, kw_n,
- kw_order, kw_x_coeffs, kw_y_coeffs, kw_envelope, kw_base, kw_duration, kw_offset, kw_end,
- kw_direction, kw_degree, kw_distance, kw_reverb, kw_output, kw_fft_size,
- kw_expansion, kw_length, kw_hop, kw_ramp, kw_jitter,
- kw_type, kw_channels, kw_filter, kw_revout, kw_width,
- kw_edit, kw_synthesize, kw_analyze, kw_interp, kw_overlap, kw_pitch,
- kw_distribution, kw_coeffs, kw_kind;
-
-
- static void init_keywords(void)
- {
- /* in Ruby there's rb_intern of the symbol -- is it safe? */
- kw_frequency = Xen_make_keyword("frequency");
- kw_initial_phase = Xen_make_keyword("initial-phase");
- kw_wave = Xen_make_keyword("wave");
- kw_amplitude = Xen_make_keyword("amplitude");
- kw_r = Xen_make_keyword("r");
- kw_ratio = Xen_make_keyword("ratio");
- kw_size = Xen_make_keyword("size");
- kw_a0 = Xen_make_keyword("a0");
- kw_a1 = Xen_make_keyword("a1");
- kw_a2 = Xen_make_keyword("a2");
- kw_b1 = Xen_make_keyword("b1");
- kw_b2 = Xen_make_keyword("b2");
- kw_max_size = Xen_make_keyword("max-size");
- kw_input = Xen_make_keyword("input");
- kw_srate = Xen_make_keyword("srate");
- kw_file = Xen_make_keyword("file");
- kw_channel = Xen_make_keyword("channel");
- kw_start = Xen_make_keyword("start"); /* make-readin */
- kw_initial_contents = Xen_make_keyword("initial-contents");
- kw_initial_element = Xen_make_keyword("initial-element");
- kw_scaler = Xen_make_keyword("scaler");
- kw_feedforward = Xen_make_keyword("feedforward");
- kw_feedback = Xen_make_keyword("feedback");
- kw_radius = Xen_make_keyword("radius");
- kw_partials = Xen_make_keyword("partials");
- kw_a = Xen_make_keyword("a");
- kw_n = Xen_make_keyword("n");
- kw_order = Xen_make_keyword("order");
- kw_x_coeffs = Xen_make_keyword("xcoeffs");
- kw_y_coeffs = Xen_make_keyword("ycoeffs");
- kw_envelope = Xen_make_keyword("envelope");
- kw_base = Xen_make_keyword("base");
- kw_duration = Xen_make_keyword("duration");
- kw_offset = Xen_make_keyword("offset");
- kw_end = Xen_make_keyword("end");
- kw_direction = Xen_make_keyword("direction");
- kw_degree = Xen_make_keyword("degree");
- kw_distance = Xen_make_keyword("distance");
- kw_reverb = Xen_make_keyword("reverb");
- kw_output = Xen_make_keyword("output");
- kw_fft_size = Xen_make_keyword("fft-size");
- kw_expansion = Xen_make_keyword("expansion");
- kw_length = Xen_make_keyword("length");
- kw_hop = Xen_make_keyword("hop");
- kw_ramp = Xen_make_keyword("ramp");
- kw_jitter = Xen_make_keyword("jitter");
- kw_type = Xen_make_keyword("type");
- kw_channels = Xen_make_keyword("channels");
- kw_filter = Xen_make_keyword("filter");
- kw_revout = Xen_make_keyword("revout");
- kw_width = Xen_make_keyword("width");
- kw_edit = Xen_make_keyword("edit");
- kw_synthesize = Xen_make_keyword("synthesize");
- kw_analyze = Xen_make_keyword("analyze");
- kw_interp = Xen_make_keyword("interp");
- kw_overlap = Xen_make_keyword("overlap");
- kw_pitch = Xen_make_keyword("pitch");
- kw_distribution = Xen_make_keyword("distribution");
- kw_coeffs = Xen_make_keyword("coeffs");
- kw_kind = Xen_make_keyword("kind");
- }
-
-
-
- /* ---------------- *clm-table-size* ---------------- */
-
- static mus_long_t clm_table_size = MUS_CLM_DEFAULT_TABLE_SIZE;
- #if HAVE_SCHEME
- static s7_pointer clm_table_size_symbol;
- #endif
-
- mus_long_t clm_default_table_size_c(void) {return(clm_table_size);}
-
- static Xen g_clm_table_size(void) {return(C_llong_to_Xen_llong(clm_table_size));}
-
- static Xen g_set_clm_table_size(Xen val)
- {
- mus_long_t size;
- #define H_clm_table_size "(" S_clm_table_size "): the default table size for most generators (512)"
- Xen_check_type(Xen_is_llong(val), val, 1, S_set S_clm_table_size, "an integer");
- size = Xen_llong_to_C_llong(val);
- if ((size <= 0) ||
- (size > mus_max_table_size()))
- Xen_out_of_range_error(S_set S_clm_table_size, 1, val, "invalid size (see mus-max-table-size)");
- clm_table_size = size;
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, clm_table_size_symbol, s7_make_integer(s7, clm_table_size));
- #endif
- return(C_llong_to_Xen_llong(clm_table_size));
- }
-
-
- /* ---------------- *clm-default-frequency* ---------------- */
-
- static mus_float_t clm_default_frequency = MUS_CLM_DEFAULT_FREQUENCY;
- #if HAVE_SCHEME
- static s7_pointer clm_default_frequency_symbol;
- #endif
-
- mus_float_t clm_default_frequency_c(void) {return(clm_default_frequency);}
-
- static Xen g_clm_default_frequency(void) {return(C_double_to_Xen_real(clm_default_frequency));}
-
- static Xen g_set_clm_default_frequency(Xen val)
- {
- #define H_clm_default_frequency "(" S_clm_default_frequency "): the default frequency for most generators (0.0)"
- Xen_check_type(Xen_is_double(val), val, 1, S_set S_clm_default_frequency, "a number");
- clm_default_frequency = Xen_real_to_C_double(val);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, clm_default_frequency_symbol, s7_make_real(s7, clm_default_frequency));
- #endif
- return(val);
- }
-
-
-
- /* ---------------- AM and simple stuff ---------------- */
-
- static const char *fft_window_xen_names[MUS_NUM_FFT_WINDOWS] =
- {S_rectangular_window, S_hann_window, S_welch_window, S_parzen_window, S_bartlett_window,
- S_hamming_window, S_blackman2_window, S_blackman3_window, S_blackman4_window,
- S_exponential_window, S_riemann_window, S_kaiser_window, S_cauchy_window,
- S_poisson_window, S_gaussian_window, S_tukey_window, S_dolph_chebyshev_window,
- S_hann_poisson_window, S_connes_window, S_samaraki_window, S_ultraspherical_window,
- S_bartlett_hann_window, S_bohman_window, S_flat_top_window,
- S_blackman5_window, S_blackman6_window, S_blackman7_window, S_blackman8_window, S_blackman9_window, S_blackman10_window,
- S_rv2_window, S_rv3_window, S_rv4_window, S_mlt_sine_window, S_papoulis_window, S_dpss_window, S_sinc_window
- };
-
-
- const char *mus_fft_window_xen_name(mus_fft_window_t i) {return(fft_window_xen_names[(int)i]);}
-
-
- static Xen g_mus_file_buffer_size(void)
- {
- #define H_mus_file_buffer_size "(" S_mus_file_buffer_size "): current CLM IO buffer size (default is 8192)"
- return(C_llong_to_Xen_llong(mus_file_buffer_size()));
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer mus_file_buffer_size_symbol;
- #endif
-
- static Xen g_mus_set_file_buffer_size(Xen val)
- {
- mus_long_t len;
- Xen_check_type(Xen_is_llong(val), val, 1, S_set S_mus_file_buffer_size, "an integer");
- len = Xen_llong_to_C_llong(val);
- if (len <= 0)
- Xen_out_of_range_error(S_set S_mus_file_buffer_size, 1, val, "must be > 0");
- mus_set_file_buffer_size(len);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, mus_file_buffer_size_symbol, s7_make_integer(s7, len));
- #endif
- return(val);
- }
-
-
- static Xen g_radians_to_hz(Xen val)
- {
- #define H_radians_to_hz "(" S_radians_to_hz " rads): convert radians per sample to frequency in Hz: rads * srate / (2 * pi)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_radians_to_hz, 1);
- return(C_double_to_Xen_real(mus_radians_to_hz(x)));
- }
-
-
- static Xen g_hz_to_radians(Xen val)
- {
- #define H_hz_to_radians "(" S_hz_to_radians " hz): convert frequency in Hz to radians per sample: hz * 2 * pi / srate"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_hz_to_radians, 1);
- return(C_double_to_Xen_real(mus_hz_to_radians(x)));
- }
-
-
- static Xen g_radians_to_degrees(Xen val)
- {
- #define H_radians_to_degrees "(" S_radians_to_degrees " rads): convert radians to degrees: rads * 360 / (2 * pi)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_radians_to_degrees, 1);
- return(C_double_to_Xen_real(mus_radians_to_degrees(x)));
- }
-
-
- static Xen g_degrees_to_radians(Xen val)
- {
- #define H_degrees_to_radians "(" S_degrees_to_radians " deg): convert degrees to radians: deg * 2 * pi / 360"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_degrees_to_radians, 1);
- return(C_double_to_Xen_real(mus_degrees_to_radians(x)));
- }
-
-
- static Xen g_db_to_linear(Xen val)
- {
- #define H_db_to_linear "(" S_db_to_linear " db): convert decibel value db to linear value: pow(10, db / 20)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_db_to_linear, 1);
- return(C_double_to_Xen_real(mus_db_to_linear(x)));
- }
-
-
- static Xen g_linear_to_db(Xen val)
- {
- #define H_linear_to_db "(" S_linear_to_db " lin): convert linear value to decibels: 20 * log10(lin)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_linear_to_db, 1);
- return(C_double_to_Xen_real(mus_linear_to_db(x)));
- }
-
-
- static Xen g_even_weight(Xen val)
- {
- #define H_even_weight "(" S_even_weight " x): return the even weight of x"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_even_weight, 1);
- return(C_double_to_Xen_real(mus_even_weight(x)));
- }
-
-
- static Xen g_odd_weight(Xen val)
- {
- #define H_odd_weight "(" S_odd_weight " x): return the odd weight of x"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_odd_weight, 1);
- return(C_double_to_Xen_real(mus_odd_weight(x)));
- }
-
-
- static Xen g_even_multiple(Xen val1, Xen val2)
- {
- #define H_even_multiple "(" S_even_multiple " x y): return the even multiple of x and y"
- mus_float_t x, y;
- Xen_to_C_double_or_error(val1, x, S_even_multiple, 1);
- Xen_to_C_double_or_error(val2, y, S_even_multiple, 2);
- return(C_double_to_Xen_real(mus_even_multiple(x, y)));
- }
-
-
- static Xen g_odd_multiple(Xen val1, Xen val2)
- {
- #define H_odd_multiple "(" S_odd_multiple " x y): return the odd multiple of x and y"
- mus_float_t x, y;
- Xen_to_C_double_or_error(val1, x, S_odd_multiple, 1);
- Xen_to_C_double_or_error(val2, y, S_odd_multiple, 2);
- return(C_double_to_Xen_real(mus_odd_multiple(x, y)));
- }
-
-
- static Xen g_seconds_to_samples(Xen val)
- {
- #define H_seconds_to_samples "(" S_seconds_to_samples " secs): use " S_mus_srate " to convert seconds to samples"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_seconds_to_samples, 1);
- return(C_llong_to_Xen_llong(mus_seconds_to_samples(x)));
- }
-
-
- static Xen g_samples_to_seconds(Xen val)
- {
- #define H_samples_to_seconds "(" S_samples_to_seconds " samps): use " S_mus_srate " to convert samples to seconds"
- Xen_check_type(Xen_is_llong(val), val, 1, S_samples_to_seconds, "a number");
- return(C_double_to_Xen_real(mus_samples_to_seconds(Xen_llong_to_C_llong(val))));
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer clm_srate_symbol;
- #endif
-
- static Xen g_mus_srate(void)
- {
- #define H_mus_srate "(" S_mus_srate "): current sampling rate"
- return(C_double_to_Xen_real(mus_srate()));
- }
-
-
- static Xen g_mus_set_srate(Xen val)
- {
- mus_float_t sr;
- Xen_check_type(Xen_is_number(val), val, 1, S_set S_mus_srate, "a number");
- sr = Xen_real_to_C_double(val);
- if (sr != mus_srate())
- {
- if (sr <= 0.0)
- Xen_out_of_range_error(S_set S_mus_srate, 1, val, "must be > 0.0");
- mus_set_srate(sr);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, clm_srate_symbol, s7_make_real(s7, sr));
- #endif
- }
- return(val);
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer mus_float_equal_fudge_factor_symbol;
- #endif
-
- static Xen g_mus_float_equal_fudge_factor(void)
- {
- #define H_mus_float_equal_fudge_factor "(" S_mus_float_equal_fudge_factor "): floating point equality fudge factor"
- return(C_double_to_Xen_real(mus_float_equal_fudge_factor()));
- }
-
-
- static Xen g_mus_set_float_equal_fudge_factor(Xen val)
- {
- mus_float_t factor;
- Xen_check_type(Xen_is_number(val), val, 1, S_set S_mus_float_equal_fudge_factor, "a number");
- factor = Xen_real_to_C_double(val);
- if (factor != mus_float_equal_fudge_factor())
- {
- mus_set_float_equal_fudge_factor(factor);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, mus_float_equal_fudge_factor_symbol, s7_make_real(s7, factor));
- #endif
- }
- return(val);
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer mus_array_print_length_symbol;
- #endif
-
- static Xen g_mus_array_print_length(void)
- {
- #define H_mus_array_print_length "(" S_mus_array_print_length "): current clm array print length (default is 8). This \
- affects error reporting and generator descriptions. Array (" S_vct ") elements beyond this length are represented by '...'"
- return(C_int_to_Xen_integer(mus_array_print_length()));
- }
-
-
- static Xen g_mus_set_array_print_length(Xen val)
- {
- int len;
- Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mus_array_print_length, "an integer");
- len = Xen_integer_to_C_int(val);
- if (len != mus_array_print_length())
- {
- if (len < 0)
- Xen_out_of_range_error(S_set S_mus_array_print_length, 1, val, "must be >= 0");
- mus_set_array_print_length(len);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, mus_array_print_length_symbol, s7_make_integer(s7, len));
- #endif
- }
- return(val);
- }
-
-
- static Xen g_ring_modulate(Xen val1, Xen val2)
- {
- #define H_ring_modulate "(" S_ring_modulate " s1 s2): s1 * s2 (sample by sample multiply)"
- Xen_check_type(Xen_is_number(val1), val1, 1, S_ring_modulate, "a number");
- Xen_check_type(Xen_is_number(val2), val2, 2, S_ring_modulate, "a number");
- return(C_double_to_Xen_real(mus_ring_modulate(Xen_real_to_C_double(val1), Xen_real_to_C_double(val2))));
- }
-
-
- static Xen g_amplitude_modulate(Xen val1, Xen val2, Xen val3)
- {
- #define H_amplitude_modulate "(" S_amplitude_modulate " carrier in1 in2): in1 * (carrier + in2)"
- Xen_check_type(Xen_is_number(val1), val1, 1, S_amplitude_modulate, "a number");
- Xen_check_type(Xen_is_number(val2), val2, 2, S_amplitude_modulate, "a number");
- Xen_check_type(Xen_is_number(val3), val3, 3, S_amplitude_modulate, "a number");
- return(C_double_to_Xen_real(mus_amplitude_modulate(Xen_real_to_C_double(val1), Xen_real_to_C_double(val2), Xen_real_to_C_double(val3))));
- }
-
-
- static Xen g_contrast_enhancement(Xen val1, Xen val2)
- {
- mus_float_t index = 1.0; /* this is the default in clm.html and mus.lisp */
- #define H_contrast_enhancement "(" S_contrast_enhancement " sig (index 1.0)): sin(sig * pi / 2 + index * sin(sig * 2 * pi))"
- Xen_check_type(Xen_is_number(val1), val1, 1, S_contrast_enhancement, "a number");
- if (Xen_is_bound(val2))
- {
- Xen_check_type(Xen_is_number(val2), val2, 2, S_contrast_enhancement, "a number");
- index = Xen_real_to_C_double(val2);
- }
- return(C_double_to_Xen_real(mus_contrast_enhancement(Xen_real_to_C_double(val1), index)));
- }
-
-
- static Xen g_dot_product(Xen val1, Xen val2, Xen size)
- {
- #define H_dot_product "(" S_dot_product " v1 v2 (size)): sum of v1[i] * v2[i] (also named scalar product)"
- vct *v1, *v2;
- mus_long_t len;
-
- Xen_check_type(mus_is_vct(val1), val1, 1, S_dot_product, "a " S_vct);
- Xen_check_type(mus_is_vct(val2), val2, 2, S_dot_product, "a " S_vct);
- Xen_check_type(Xen_is_llong_or_unbound(size), size, 3, S_dot_product, "an integer");
-
- v1 = Xen_to_vct(val1);
- v2 = Xen_to_vct(val2);
- if (Xen_is_llong(size))
- {
- len = Xen_llong_to_C_llong(size);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- if (len < 0)
- Xen_out_of_range_error(S_dot_product, 3, size, "size < 0?");
- if (len > mus_vct_length(v1)) len = mus_vct_length(v1);
- }
- else len = mus_vct_length(v1);
- if (len > mus_vct_length(v2)) len = mus_vct_length(v2);
-
- return(C_double_to_Xen_real(mus_dot_product(mus_vct_data(v1), mus_vct_data(v2), len)));
- }
-
-
- #if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
-
- #if defined(__sun) && defined(__SVR4)
- #undef _Complex_I
- #define _Complex_I 1.0fi
- #endif
-
- #define S_edot_product "edot-product"
-
- static Xen g_edot_product(Xen val1, Xen val2)
- {
- #define H_edot_product "(" S_edot_product " freq data): sum of (e^freq*i) * data[i]"
- mus_long_t i, len;
- vct *v = NULL;
- complex double freq;
- complex double *vals;
- Xen result;
-
- Xen_check_type(Xen_is_complex(val1), val1, 1, S_edot_product, "complex");
- Xen_check_type((mus_is_vct(val2)) || (Xen_is_vector(val2)), val2, 2, S_edot_product, "a " S_vct);
-
- freq = Xen_complex_to_C_complex(val1);
- if (mus_is_vct(val2))
- {
- v = Xen_to_vct(val2);
- len = mus_vct_length(v);
- }
- else
- {
- len = Xen_vector_length(val2);
- }
- vals = (complex double *)calloc(len, sizeof(complex double));
- if (mus_is_vct(val2))
- {
- mus_float_t *vdata;
- vdata = mus_vct_data(v);
- for (i = 0; i < len; i++)
- vals[i] = vdata[i];
- }
- else
- {
- for (i = 0; i < len; i++)
- vals[i] = Xen_complex_to_C_complex(Xen_vector_ref(val2, i));
- }
- result = C_complex_to_Xen_complex(mus_edot_product(freq, vals, len));
- free(vals);
- return(result);
- }
- #endif
-
- typedef enum {G_RECTANGULAR_POLAR, G_POLAR_RECTANGULAR, G_RECTANGULAR_MAGNITUDES} xclm_window_t;
-
- static Xen g_fft_window_1(xclm_window_t choice, Xen val1, Xen val2, Xen ulen, const char *caller)
- {
- vct *v1, *v2;
- mus_long_t len;
-
- Xen_check_type(mus_is_vct(val1), val1, 1, caller, "a " S_vct);
- Xen_check_type(mus_is_vct(val2), val2, 2, caller, "a " S_vct);
- Xen_check_type(Xen_is_llong_or_unbound(ulen), ulen, 3, caller, "an integer");
-
- v1 = Xen_to_vct(val1);
- v2 = Xen_to_vct(val2);
- if (Xen_is_llong(ulen))
- {
- len = Xen_llong_to_C_llong(ulen);
- if (len == 0) return(Xen_false);
- if (len < 0)
- Xen_out_of_range_error(caller, 3, ulen, "size < 0?");
- if (len > mus_vct_length(v1)) len = mus_vct_length(v1);
- }
- else len = mus_vct_length(v1);
- if (len > mus_vct_length(v2)) len = mus_vct_length(v2);
- switch (choice)
- {
- case G_RECTANGULAR_POLAR: mus_rectangular_to_polar(mus_vct_data(v1), mus_vct_data(v2), len); break;
- case G_RECTANGULAR_MAGNITUDES: mus_rectangular_to_magnitudes(mus_vct_data(v1), mus_vct_data(v2), len); break;
- case G_POLAR_RECTANGULAR: mus_polar_to_rectangular(mus_vct_data(v1), mus_vct_data(v2), len); break;
- }
- return(val1);
- }
-
-
- static Xen g_rectangular_to_polar(Xen val1, Xen val2)
- {
- #define H_rectangular_to_polar "(" S_rectangular_to_polar " rl im): convert real/imaginary \
- data in " S_vct "s rl and im from rectangular form (fft output) to polar form (a spectrum)"
-
- return(g_fft_window_1(G_RECTANGULAR_POLAR, val1, val2, Xen_undefined, S_rectangular_to_polar));
- }
-
-
- static Xen g_rectangular_to_magnitudes(Xen val1, Xen val2)
- {
- #define H_rectangular_to_magnitudes "(" S_rectangular_to_magnitudes " rl im): convert real/imaginary \
- data in " S_vct "s rl and im from rectangular form (fft output) to polar form, but ignore the phases"
-
- return(g_fft_window_1(G_RECTANGULAR_MAGNITUDES, val1, val2, Xen_undefined, S_rectangular_to_magnitudes));
- }
-
-
- static Xen g_polar_to_rectangular(Xen val1, Xen val2)
- {
- #define H_polar_to_rectangular "(" S_polar_to_rectangular " rl im): convert real/imaginary \
- data in " S_vct "s rl and im from polar (spectrum) to rectangular (fft)"
-
- return(g_fft_window_1(G_POLAR_RECTANGULAR, val1, val2, Xen_undefined, S_polar_to_rectangular));
- }
-
- #if HAVE_SCHEME
- #if (!WITH_GMP)
- #define PF2_TO_PF(CName, Cfnc) \
- static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x, y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- f = (s7_pf_t)(**p); (*p)++; \
- y = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_pf(sc, s7_caddr(expr)))) \
- return(CName ## _pf_a); \
- return(NULL); \
- }
-
- PF2_TO_PF(rectangular_to_polar, g_rectangular_to_polar(x, y))
- PF2_TO_PF(polar_to_rectangular, g_polar_to_rectangular(x, y))
- PF2_TO_PF(rectangular_to_magnitudes, g_rectangular_to_magnitudes(x, y))
- #endif
- #endif
-
-
- static Xen g_mus_fft(Xen url, Xen uim, Xen len, Xen usign)
- {
- #define H_mus_fft "(" S_mus_fft " rl im (len) (dir 1)): return the fft of " S_vct "s rl and im which contain \
- the real and imaginary parts of the data; len should be a power of 2, dir = 1 for fft, -1 for inverse-fft"
-
- int sign;
- mus_long_t n;
- vct *v1, *v2;
-
- Xen_check_type((mus_is_vct(url)), url, 1, S_mus_fft, "a " S_vct);
- Xen_check_type((mus_is_vct(uim)), uim, 2, S_mus_fft, "a " S_vct);
-
- v1 = Xen_to_vct(url);
- v2 = Xen_to_vct(uim);
-
- if (Xen_is_integer(usign))
- sign = Xen_integer_to_C_int(usign);
- else sign = 1;
-
- if (Xen_is_llong(len))
- {
- n = Xen_llong_to_C_llong(len);
- if (n <= 0)
- Xen_out_of_range_error(S_mus_fft, 3, len, "size <= 0?");
- if (n > mus_max_malloc())
- Xen_out_of_range_error(S_mus_fft, 3, len, "size too large (see mus-max-malloc)");
- if (n > mus_vct_length(v1))
- n = mus_vct_length(v1);
- }
- else n = mus_vct_length(v1);
-
- if (n > mus_vct_length(v2))
- n = mus_vct_length(v2);
-
- if (!(is_power_of_2(n)))
- {
- mus_float_t nf;
- int np;
- nf = (log(n) / log(2.0));
- np = (int)nf;
- n = (mus_long_t)pow(2.0, np);
- }
-
- if (n > 0)
- mus_fft(mus_vct_data(v1), mus_vct_data(v2), n, sign);
- /*
- * in fftw, there's the extra complex array allocation, so for n = 2^29
- * (and doubles for vcts as well as fftw), we need 24.6 Gbytes, and the FFT
- * takes 144 secs on a 2.4 GHz machine. (Similarly, 2^28 needs 12.6 Gb
- * and takes 61 secs).
- */
-
- return(url);
- }
-
-
- static Xen g_make_fft_window(Xen type, Xen size, Xen ubeta, Xen ualpha)
- {
- #if HAVE_SCHEME
- #define make_window_example "(" S_make_fft_window " " S_hamming_window " 256)"
- #endif
- #if HAVE_RUBY
- #define make_window_example "make_fft_window(Hamming_window, 256)"
- #endif
- #if HAVE_FORTH
- #define make_window_example "hamming-window 256 make-fft-window"
- #endif
-
- #define H_make_fft_window "(" S_make_fft_window " type size (beta 0.0) (alpha 0.0)): -> fft data window (a " S_vct "). \
- type is one of the sndlib fft window identifiers such as " S_kaiser_window ", beta \
- is the window family parameter, if any:\n " make_window_example
-
- mus_float_t beta = 0.0, alpha = 0.0;
- mus_long_t n;
- int fft_window;
- mus_float_t *data;
-
- Xen_check_type(Xen_is_integer(type), type, 1, S_make_fft_window, "an integer (window type)");
- Xen_check_type(Xen_is_llong(size), size, 2, S_make_fft_window, "an integer");
-
- if (Xen_is_number(ubeta)) beta = Xen_real_to_C_double(ubeta);
- if (Xen_is_number(ualpha)) alpha = Xen_real_to_C_double(ualpha);
-
- n = Xen_llong_to_C_llong(size);
- if (n <= 0)
- Xen_out_of_range_error(S_make_fft_window, 2, size, "size <= 0?");
- if (n > mus_max_malloc())
- Xen_out_of_range_error(S_make_fft_window, 2, size, "size too large (see mus-max-malloc)");
-
- fft_window = Xen_integer_to_C_int(type);
- if (!(mus_is_fft_window(fft_window)))
- Xen_out_of_range_error(S_make_fft_window, 1, type, "unknown fft window");
-
- data = (mus_float_t *)malloc(n * sizeof(mus_float_t));
- mus_make_fft_window_with_window((mus_fft_window_t)fft_window, n, beta, alpha, data);
- return(xen_make_vct(n, data));
- }
-
-
- static Xen g_spectrum(Xen url, Xen uim, Xen uwin, Xen utype)
- {
- #define H_mus_spectrum "(" S_spectrum " rl im window (type 1)): \
- real and imaginary data in " S_vct "s rl and im, returns (in rl) the spectrum thereof; \
- window is the fft data window (a " S_vct " as returned by " S_make_fft_window "), \
- and type determines how the spectral data is scaled:\n\
- 0 = data in dB,\n\
- 1 (default) = linear and normalized\n\
- 2 = linear and un-normalized."
-
- int type;
- mus_long_t n;
- vct *v1, *v2, *v3 = NULL;
-
- Xen_check_type((mus_is_vct(url)), url, 1, S_spectrum, "a " S_vct);
- Xen_check_type((mus_is_vct(uim)), uim, 2, S_spectrum, "a " S_vct);
- if (!Xen_is_false(uwin)) Xen_check_type((mus_is_vct(uwin)), uwin, 3, S_spectrum, "a " S_vct " or " PROC_FALSE);
-
- v1 = Xen_to_vct(url);
- v2 = Xen_to_vct(uim);
- if (!Xen_is_false(uwin)) v3 = Xen_to_vct(uwin);
-
- n = mus_vct_length(v1);
- if (n > mus_vct_length(v2))
- n = mus_vct_length(v2);
- if ((v3) && (n > mus_vct_length(v3)))
- n = mus_vct_length(v3);
-
- if (!(is_power_of_2(n)))
- {
- mus_float_t nf;
- int np;
- nf = (log(n) / log(2.0));
- np = (int)nf;
- n = (int)pow(2.0, np);
- }
-
- if (Xen_is_integer(utype))
- type = Xen_integer_to_C_int(utype);
- else type = 1; /* linear normalized */
- if ((type < 0) || (type > 2))
- Xen_out_of_range_error(S_spectrum, 4, utype, "type must be 0..2");
-
- if (n > 0)
- mus_spectrum(mus_vct_data(v1), mus_vct_data(v2), (v3) ? (mus_vct_data(v3)) : NULL, n, (mus_spectrum_t)type);
- return(url);
- }
-
-
- static Xen g_autocorrelate(Xen reals)
- {
- #define H_autocorrelate "(" S_autocorrelate " data): in place autocorrelation of data (a " S_vct ")"
- /* assumes length is power of 2 */
- vct *v1 = NULL;
- Xen_check_type(mus_is_vct(reals), reals, 1, S_autocorrelate, "a " S_vct);
- v1 = Xen_to_vct(reals);
- if (mus_vct_length(v1) > 0)
- mus_autocorrelate(mus_vct_data(v1), mus_vct_length(v1));
- return(reals);
- }
-
-
- static Xen g_correlate(Xen data1, Xen data2)
- {
- #define H_correlate "(" S_correlate " data1 data2): in place cross-correlation of data1 and data2 (both " S_vct "s)"
- mus_long_t size;
- vct *v1 = NULL, *v2 = NULL;
-
- Xen_check_type(mus_is_vct(data1), data1, 1, S_correlate, "a " S_vct);
- Xen_check_type(mus_is_vct(data2), data2, 2, S_correlate, "a " S_vct);
-
- v1 = Xen_to_vct(data1);
- v2 = Xen_to_vct(data2);
- if (mus_vct_length(v1) < mus_vct_length(v2))
- size = mus_vct_length(v1);
- else size = mus_vct_length(v2);
-
- if (size > 0)
- mus_correlate(mus_vct_data(v1), mus_vct_data(v2), size);
- return(data1);
- }
-
-
- static Xen g_convolution(Xen url1, Xen url2, Xen un)
- {
- #define H_mus_convolution "(" S_convolution " v1 v2 (len)): convolution \
- of " S_vct "s v1 with v2, using fft of size len (a power of 2), result in v1"
-
- mus_long_t n;
- vct *v1, *v2;
-
- Xen_check_type((mus_is_vct(url1)), url1, 1, S_convolution, "a " S_vct);
- Xen_check_type((mus_is_vct(url2)), url2, 2, S_convolution, "a " S_vct);
-
- v1 = Xen_to_vct(url1);
- v2 = Xen_to_vct(url2);
-
- if (Xen_is_integer(un))
- {
- n = Xen_llong_to_C_llong(un);
- if (n <= 0)
- Xen_out_of_range_error(S_convolution, 3, un, "size <= 0?");
- if (n > mus_max_malloc())
- Xen_out_of_range_error(S_convolution, 3, un, "size too large (see mus-max-malloc)");
- if (n > mus_vct_length(v1))
- n = mus_vct_length(v1);
- }
- else n = mus_vct_length(v1);
- if (n > mus_vct_length(v2))
- n = mus_vct_length(v2);
- if (!(is_power_of_2(n)))
- {
- mus_float_t nf;
- int np;
- nf = (log(n) / log(2.0));
- np = (int)nf;
- n = (int)pow(2.0, np);
- }
- if (n > 0)
- mus_convolution(mus_vct_data(v1), mus_vct_data(v2), n);
- return(url1);
- }
-
-
- static Xen g_polynomial(Xen arr, Xen x)
- {
- #define H_polynomial "(" S_polynomial " coeffs x): evaluate a polynomial at x. coeffs are in order \
- of degree, so coeff[0] is the constant term."
-
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(x), x, 2, S_polynomial, "a number");
- #endif
- if (mus_is_vct(arr))
- {
- vct *v;
- v = Xen_to_vct(arr);
- return(C_double_to_Xen_real(mus_polynomial(mus_vct_data(v), Xen_real_to_C_double_with_caller(x, S_polynomial), mus_vct_length(v))));
- }
-
- Xen_check_type(Xen_is_vector(arr), arr, 1, S_polynomial, "a vector or " S_vct);
- {
- mus_float_t sum, cx;
- int i, ncoeffs;
-
- ncoeffs = Xen_vector_length(arr);
- if (ncoeffs <= 0) return(C_double_to_Xen_real(0.0));
- if (ncoeffs == 1) return(Xen_vector_ref(arr, 0)); /* just a constant term */
-
- cx = Xen_real_to_C_double_with_caller(x, S_polynomial);
- sum = Xen_real_to_C_double_with_caller(Xen_vector_ref(arr, ncoeffs - 1), S_polynomial);
- for (i = ncoeffs - 2; i >= 0; i--)
- sum = (sum * cx) + Xen_real_to_C_double_with_caller(Xen_vector_ref(arr, i), S_polynomial);
- return(C_double_to_Xen_real(sum));
- }
- }
-
-
- static Xen g_array_interp(Xen obj, Xen phase, Xen size) /* opt size */
- {
- #define H_array_interp "(" S_array_interp " v phase (size)): v[phase] \
- taking into account wrap-around (size is size of data), with linear interpolation if phase is not an integer."
-
- mus_long_t len;
- vct *v;
-
- Xen_check_type(mus_is_vct(obj), obj, 1, S_array_interp, "a " S_vct);
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(phase), phase, 2, S_array_interp, "a number");
- #endif
- Xen_check_type(Xen_is_llong_or_unbound(size), size, 3, S_array_interp, "an integer");
-
- v = Xen_to_vct(obj);
- if (Xen_is_bound(size))
- {
- len = Xen_llong_to_C_llong(size);
- if (len <= 0)
- Xen_out_of_range_error(S_array_interp, 3, size, "size <= 0?");
- if (len > mus_vct_length(v))
- len = mus_vct_length(v);
- }
- else len = mus_vct_length(v);
- if (len == 0)
- return(C_double_to_Xen_real(0.0));
- return(C_double_to_Xen_real(mus_array_interp(mus_vct_data(v), Xen_real_to_C_double_with_caller(phase, S_array_interp), len)));
- }
-
-
- static Xen g_mus_interpolate(Xen type, Xen x, Xen obj, Xen size, Xen yn1)
- {
- #define H_mus_interpolate "(" S_mus_interpolate " type x v (size) (yn1 0.0)): interpolate in \
- data ('v' is a " S_vct ") using interpolation 'type', such as " S_mus_interp_linear "."
-
- mus_long_t len;
- int itype;
- vct *v;
- mus_float_t y = 0.0;
-
- Xen_check_type(Xen_is_integer(type), type, 1, S_mus_interpolate, "an integer (interp type such as " S_mus_interp_all_pass ")");
- Xen_check_type(Xen_is_number(x), x, 2, S_mus_interpolate, "a number");
- Xen_check_type(mus_is_vct(obj), obj, 3, S_mus_interpolate, "a " S_vct);
- Xen_check_type(Xen_is_llong_or_unbound(size), size, 4, S_mus_interpolate, "an integer");
- Xen_check_type(Xen_is_number_or_unbound(yn1), yn1, 5, S_mus_interpolate, "a number");
-
- itype = Xen_integer_to_C_int(type);
- if (!(mus_is_interp_type(itype)))
- Xen_out_of_range_error(S_mus_interpolate, 1, type, "unknown interp type");
-
- v = Xen_to_vct(obj);
-
- if (Xen_is_bound(size))
- {
- len = Xen_llong_to_C_llong(size);
- if (len <= 0)
- Xen_out_of_range_error(S_mus_interpolate, 4, size, "size <= 0?");
- if (len > mus_vct_length(v))
- len = mus_vct_length(v);
- }
- else len = mus_vct_length(v);
- if (len == 0)
- return(C_double_to_Xen_real(0.0));
-
- if (Xen_is_number(yn1))
- y = Xen_real_to_C_double(yn1);
-
- return(C_double_to_Xen_real(mus_interpolate((mus_interp_t)itype, Xen_real_to_C_double(x), mus_vct_data(v), len, y)));
- }
-
-
-
- /* ---------------- mus-xen struct ---------------- */
-
- static Xen_object_type_t mus_xen_tag;
-
- bool mus_is_xen(Xen obj) {return(Xen_c_object_is_type(obj, mus_xen_tag));}
-
- #define Xen_to_C_generator(Xen_Arg, X_Val, C_Val, Checker, Caller, Descr) \
- Xen_check_type((X_Val = (mus_xen *)Xen_object_ref_checked(Xen_Arg, mus_xen_tag)) && (Checker(C_Val = (mus_any *)mus_xen_to_mus_any(X_Val))), Xen_Arg, 1, Caller, Descr)
-
- #define Xen_to_C_any_generator(Xen_Arg, X_Val, C_Val, Caller, Descr) \
- Xen_check_type((X_Val = (mus_xen *)Xen_object_ref_checked(Xen_Arg, mus_xen_tag)) && (C_Val = (mus_any *)mus_xen_to_mus_any(X_Val)), Xen_Arg, 1, Caller, Descr)
-
-
-
- static Xen g_is_mus_generator(Xen obj)
- {
- #define H_is_mus_generator "(" S_is_mus_generator " obj): " PROC_TRUE " if 'obj' is a CLM generator."
- return(C_bool_to_Xen_boolean(mus_is_xen(obj)));
- }
-
-
- #if HAVE_SCHEME
- static Xen_object_mark_t mark_mus_xen(void *obj)
- #else
- static Xen_object_mark_t mark_mus_xen(Xen obj)
- #endif
- {
- mus_xen *ms;
- #if HAVE_RUBY || HAVE_SCHEME
- /* rb_gc_mark and scheme_mark_object pass us the actual value, not the Xen wrapper */
- ms = (mus_xen *)obj;
- #endif
- #if HAVE_FORTH
- ms = Xen_to_mus_xen(obj);
- #endif
- if (ms->vcts)
- {
- int i, lim;
- lim = MUS_SELF_WRAPPER;
- if (ms->nvcts < lim) lim = ms->nvcts;
- #if HAVE_SCHEME
- if (ms->free_data) /* set if rf functions are using these two vct slots */
- {
- for (i = 0; i < lim; i++)
- if ((i != MUS_INPUT_FUNCTION) &&
- (i != MUS_INPUT_DATA) &&
- (Xen_is_bound(ms->vcts[i])))
- xen_gc_mark(ms->vcts[i]);
- return;
- }
- #endif
- for (i = 0; i < lim; i++)
- if (Xen_is_bound(ms->vcts[i]))
- xen_gc_mark(ms->vcts[i]);
- }
- #if HAVE_RUBY
- return(NULL);
- #endif
- #if (!HAVE_EXTENSION_LANGUAGE)
- return(0);
- #endif
- }
-
-
- static void mus_xen_free(mus_xen *ms)
- {
- mus_free(ms->gen);
- ms->gen = NULL;
- mx_free(ms);
- }
-
- Xen_wrap_free(mus_xen, free_mus_xen, mus_xen_free)
-
-
- #if HAVE_SCHEME
- static char *print_mus_xen(s7_scheme *sc, void *obj)
- {
- return(mus_describe(((mus_xen *)obj)->gen));
- }
-
- static bool s7_equalp_mus_xen(void *val1, void *val2)
- {
- return(mus_equalp(((mus_xen *)val1)->gen, ((mus_xen *)val2)->gen));
- }
- #endif
-
-
- enum {G_FILTER_STATE, G_FILTER_XCOEFFS, G_FILTER_YCOEFFS};
- /* G_FILTER_STATE must = MUS_DATA_WRAPPER = 0 */
- enum {G_LOCSIG_DATA, G_LOCSIG_REVDATA, G_LOCSIG_OUT, G_LOCSIG_REVOUT};
-
- static Xen mus_xen_copy(mus_xen *ms)
- {
- /* return an object -> copied mus_xen -> copied mus_any gen */
- mus_xen *np;
-
- np = mx_alloc(ms->nvcts);
- np->gen = mus_copy(ms->gen);
- if (ms->nvcts > 0)
- {
- if (ms->nvcts == 1)
- {
- if ((mus_is_env(np->gen)) || /* do the most common case first */
- (mus_is_formant_bank(np->gen)))
- np->vcts[MUS_DATA_WRAPPER] = ms->vcts[MUS_DATA_WRAPPER];
- else
- {
- if ((mus_is_comb_bank(np->gen)) ||
- (mus_is_all_pass_bank(np->gen)) ||
- (mus_is_filtered_comb_bank(np->gen)))
- {
- /* set up objects for new gens so that they will eventually be GC'd */
- Xen v;
- int i, len;
- len = Xen_vector_length(ms->vcts[MUS_DATA_WRAPPER]);
- v = Xen_make_vector(len, Xen_false);
- np->vcts[MUS_DATA_WRAPPER] = v;
- for (i = 0; i < len; i++)
- Xen_vector_set(v, i, mus_xen_to_object(mus_any_to_mus_xen(mus_bank_generator(np->gen, i))));
- }
- else np->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- }
- }
- else
- {
- if (ms->nvcts == 2)
- {
- if (mus_is_pulsed_env(np->gen))
- {
- /* mus_free taken care of by copied pulsed_env gen */
- np->vcts[0] = Xen_false;
- np->vcts[1] = Xen_false;
- }
- else
- {
- if (mus_is_filtered_comb(np->gen))
- {
- np->vcts[0] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- np->vcts[1] = Xen_false; /* filt gen but it's not wrapped */
- }
- else
- {
- np->vcts[0] = ms->vcts[0];
- np->vcts[1] = ms->vcts[1];
- }
- }
- }
- else
- {
- if (ms->nvcts == 3)
- {
- if (mus_is_oscil_bank(np->gen))
- {
- np->vcts[0] = ms->vcts[0];
- np->vcts[1] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- np->vcts[2] = ms->vcts[2];
- }
- else
- {
- np->vcts[G_FILTER_STATE] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- np->vcts[G_FILTER_XCOEFFS] = ms->vcts[G_FILTER_XCOEFFS];
- np->vcts[G_FILTER_YCOEFFS] = ms->vcts[G_FILTER_YCOEFFS];
- }
- }
- else
- {
- int i;
- for (i = 0; i < ms->nvcts; i++)
- np->vcts[i] = ms->vcts[i];
-
- if (mus_is_granulate(np->gen))
- np->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_granulate_grain_max_length(np->gen), mus_data(np->gen));
-
- if ((mus_is_convolve(np->gen)) ||
- (mus_is_src(np->gen)) ||
- (mus_is_granulate(np->gen)) ||
- (mus_is_phase_vocoder(np->gen)))
- {
- Xen c_obj;
- c_obj = mus_xen_to_object(np);
- np->vcts[MUS_SELF_WRAPPER] = c_obj;
- mus_generator_copy_feeders(np->gen, ms->gen);
- return(c_obj);
- }
- }
- }
- }
- }
- return(mus_xen_to_object(np));
- }
-
-
- #if HAVE_RUBY
- static Xen mus_xen_to_s(Xen obj)
- {
- char *str;
- Xen result;
- str = mus_describe(Xen_to_mus_any(obj));
- result = C_string_to_Xen_string(str);
- if (str) free(str);
- return(result);
- }
- #endif
-
-
- #if HAVE_FORTH
- static Xen print_mus_xen(Xen obj)
- {
- char *str;
- Xen result;
- str = mus_describe(Xen_to_mus_any(obj));
- result = fth_make_string_format("#<%s>", str);
- if (str) free(str);
- return(result);
- }
- #endif
-
-
- #if (!HAVE_SCHEME)
- static Xen equalp_mus_xen(Xen obj1, Xen obj2)
- {
- if ((!(mus_is_xen(obj1))) || (!(mus_is_xen(obj2)))) return(Xen_false);
- return(C_bool_to_Xen_boolean(mus_equalp(Xen_to_mus_any(obj1), Xen_to_mus_any(obj2))));
- }
- #endif
-
-
- #if HAVE_RUBY || HAVE_FORTH
- static Xen mus_xen_apply(Xen gen, Xen arg1, Xen arg2)
- {
- #if HAVE_FORTH
- Xen_check_type(mus_is_xen(gen), gen, 1, S_mus_apply, "a generator");
- #endif
- return(C_double_to_Xen_real(mus_run(Xen_to_mus_any(gen),
- (Xen_is_number(arg1)) ? Xen_real_to_C_double(arg1) : 0.0,
- (Xen_is_number(arg2)) ? Xen_real_to_C_double(arg2) : 0.0)));
- }
- #endif
-
- #if HAVE_SCHEME
-
- /* these are for mus_xen_tag, so need not handle float-vectors */
-
- static Xen mus_xen_apply(s7_scheme *sc, Xen gen, Xen args)
- {
- if (s7_is_pair(args))
- {
- mus_float_t arg1, arg2;
- arg1 = s7_number_to_real_with_caller(sc, s7_car(args), "mus-apply");
- args = s7_cdr(args);
- if (s7_is_pair(args))
- arg2 = s7_number_to_real_with_caller(sc, s7_car(args), "mus-apply");
- else arg2 = 0.0;
- return(s7_make_real(s7, mus_run(Xen_to_mus_any(gen), arg1, arg2)));
- }
- return(s7_make_real(s7, mus_run(Xen_to_mus_any(gen), 0.0, 0.0)));
- }
-
- static Xen s7_mus_length(s7_scheme *sc, Xen obj)
- {
- return(g_mus_length(obj));
- }
-
- static Xen g_mus_copy(Xen gen);
- static Xen s7_mus_copy(s7_scheme *sc, Xen args)
- {
- return(g_mus_copy(s7_car(args)));
- }
-
- #endif
-
-
- Xen mus_xen_to_object(mus_xen *gn) /* global for user-defined gens */
- {
- return(Xen_make_object(mus_xen_tag, gn, mark_mus_xen, free_mus_xen));
- }
-
-
- Xen mus_xen_to_object_with_vct(mus_xen *gn, Xen v) /* global for user-defined gens */
- {
- gn->vcts[MUS_DATA_WRAPPER] = v;
- return(Xen_make_object(mus_xen_tag, gn, mark_mus_xen, free_mus_xen));
- }
-
-
- mus_any *mus_optkey_to_mus_any(Xen key, const char *caller, int n, mus_any *def)
- {
- /* from Michael Scholz's sndins.c */
- if (!(Xen_is_keyword(key)))
- {
- Xen_check_type(mus_is_xen(key), key, n, caller, "a clm generator or keyword");
- return(Xen_to_mus_any(key));
- }
- return(def);
- }
-
-
- static Xen mus_optkey_to_input_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err)
- {
- if (Xen_is_procedure(key))
- {
- if (!(local_arity_ok(key, required_args)))
- Xen_bad_arity_error(caller, n, key, err);
- return(key);
- }
-
- if (mus_is_xen(key))
- {
- if (!(mus_is_input(Xen_to_mus_any(key))))
- Xen_wrong_type_arg_error(caller, n, key, "an input generator");
- return(key);
- }
-
- if ((!(Xen_is_keyword(key))) &&
- (!(Xen_is_false(key))))
- Xen_check_type(false, key, n, caller, "a procedure or input generator");
- return(def);
- }
-
-
-
- /* ---------------- wrappers ---------------- */
-
- mus_xen *mus_any_to_mus_xen(mus_any *ge)
- {
- mus_xen *gn;
- gn = mx_alloc(0);
- gn->gen = ge;
- return(gn);
- }
-
-
- mus_xen *mus_any_to_mus_xen_with_vct(mus_any *ge, Xen v)
- {
- mus_xen *gn;
- gn = mx_alloc(1);
- gn->gen = ge;
- gn->vcts[MUS_DATA_WRAPPER] = v;
- return(gn);
- }
-
-
- mus_xen *mus_any_to_mus_xen_with_two_vcts(mus_any *ge, Xen v1, Xen v2)
- {
- mus_xen *gn;
- gn = mx_alloc(2);
- gn->gen = ge;
- gn->vcts[MUS_DATA_WRAPPER] = v1;
- gn->vcts[MUS_INPUT_FUNCTION] = v2;
- return(gn);
- }
-
-
-
- /* ---------------- generic functions ---------------- */
-
-
- static Xen g_mus_reset(Xen gen)
- {
- #define H_mus_reset "(" S_mus_reset " gen): clear out gen, setting it to its default starting state"
- mus_xen *ms;
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_reset(ms->gen);
- return(gen);
- }
- #if HAVE_SCHEME
- if (s7_is_float_vector(gen))
- {
- s7_int len;
- len = s7_vector_length(gen);
- if (len > 0)
- memset((void *)s7_float_vector_elements(gen), 0, len * sizeof(s7_double));
- return(gen);
- }
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-reset"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_reset, "a generator");
- return(gen);
- }
-
- #if HAVE_SCHEME
- static s7_pointer mus_copy_symbol, copy_function;
- #endif
-
- static Xen g_mus_copy(Xen gen)
- {
- #define H_mus_copy "(" S_mus_copy " gen): return a copy of gen"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- return(mus_xen_copy(ms));
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, mus_copy_symbol);
- if (func == copy_function)
- return(s7_copy(s7, s7_list(s7, 1, gen)));
- if (func != Xen_undefined)
- return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_copy, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_run(Xen gen, Xen arg1, Xen arg2)
- {
- #define H_mus_run "(" S_mus_run " gen (arg1 0.0) (arg2 0.0)): apply gen to arg1 and arg2"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_float_t a1 = 0.0, a2 = 0.0;
- Xen_real_to_C_double_if_bound(arg1, a1, S_mus_run, 2);
- Xen_real_to_C_double_if_bound(arg2, a2, S_mus_run, 3);
- return(C_double_to_Xen_real(mus_run(ms->gen, a1, a2)));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-run"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 3, gen, arg1, arg2)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_run, "a generator");
- return(C_double_to_Xen_real(0.0));
- }
-
-
- static Xen g_mus_apply(Xen arglist)
- {
- #define H_mus_apply "(" S_mus_apply " gen args...): apply gen to args"
- mus_xen *ms;
- Xen gen;
- int arglist_len;
-
- arglist_len = Xen_list_length(arglist);
- if ((arglist_len > 3) || (arglist_len == 0))
- return(C_double_to_Xen_real(0.0));
-
- gen = Xen_car(arglist);
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_any *g;
- g = ms->gen;
-
- if (arglist_len == 1)
- return(C_double_to_Xen_real(mus_apply(g, 0.0, 0.0)));
-
- if (arglist_len == 2)
- return(C_double_to_Xen_real(mus_apply(g, Xen_real_to_C_double(Xen_cadr(arglist)), 0.0)));
-
- return(C_double_to_Xen_real(mus_apply(g,
- Xen_real_to_C_double_with_caller(Xen_cadr(arglist), "mus-apply"),
- Xen_real_to_C_double_with_caller(Xen_caddr(arglist), "mus-apply"))));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-apply"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, arglist));
- }
- #endif
- Xen_check_type(false, Xen_car(arglist), 1, S_mus_apply, "a generator");
- return(C_double_to_Xen_real(0.0));
- }
-
-
- static Xen g_mus_describe(Xen gen)
- {
- #define H_mus_describe "(" S_mus_describe " gen): return a string describing the state of CLM generator generator"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- Xen result;
- char *str;
- str = mus_describe(ms->gen);
- result = C_string_to_Xen_string(str);
- if (str) free(str);
- return(result);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-describe"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_describe, "a generator");
- return(gen);
- }
-
-
- #if HAVE_SCHEME
- #define mus_double_generic(Caller, CLM_case, Symbol) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (gn) return(C_double_to_Xen_real(CLM_case(gn->gen))); \
- func = s7_method(s7, gen, Symbol); \
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(gen);
-
- #define mus_set_double_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- Xen_check_type(Xen_is_double(val), val, 2, S_set Caller, "a float"); \
- if (gn) {CLM_case(gn->gen, Xen_real_to_C_double(val)); return(val);} \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func))) \
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val))); \
- Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
- return(val);
-
- #define mus_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (gn) return(C_llong_to_Xen_llong(CLM_case(gn->gen))); \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(gen);
-
- #define mus_set_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- Xen_check_type(Xen_is_integer(val), val, 2, Caller, "an integer"); \
- if (gn) {CLM_case(gn->gen, Xen_llong_to_C_llong(val)); return(val);} \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func))) \
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(val);
-
- #define mus_int_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (gn) return(C_int_to_Xen_integer(CLM_case(gn->gen))); \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(gen);
-
- #else
-
- #define mus_double_generic(Caller, CLM_case, Symbol) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(C_double_to_Xen_real(CLM_case(gn->gen)));
-
- #define mus_set_double_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
- Xen_check_type(Xen_is_double(val), val, 2, S_set Caller, "a float"); \
- CLM_case(gn->gen, Xen_real_to_C_double(val)); \
- return(val);
-
- #define mus_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(C_llong_to_Xen_llong(CLM_case(gn->gen)));
-
- #define mus_set_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
- Xen_check_type(Xen_is_integer(val), val, 2, S_set Caller, "an integer"); \
- CLM_case(gn->gen, Xen_llong_to_C_llong(val)); \
- return(val);
-
- #define mus_int_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(C_int_to_Xen_integer(CLM_case(gn->gen)));
-
- #endif
-
- #if HAVE_SCHEME
- static Xen sym_frequency, sym_phase, sym_scaler, sym_increment, sym_width, sym_offset, sym_feedforward, sym_feedback;
- #endif
-
- static Xen g_mus_frequency(Xen gen)
- {
- #define H_mus_frequency "(" S_mus_frequency " gen): gen's frequency (Hz)"
- mus_double_generic(S_mus_frequency, mus_frequency, sym_frequency);
- }
-
- static Xen g_mus_set_frequency(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_frequency, mus_set_frequency);
- }
-
-
- static Xen g_mus_phase(Xen gen)
- {
- #define H_mus_phase "(" S_mus_phase " gen): gen's current phase (radians)"
- mus_double_generic(S_mus_phase, mus_phase, sym_phase);
- }
-
- static Xen g_mus_set_phase(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_phase, mus_set_phase);
- }
-
-
- static Xen g_mus_scaler(Xen gen)
- {
- #define H_mus_scaler "(" S_mus_scaler " gen): gen's scaler, if any. This is often an amplitude adjustment of some sort."
- mus_double_generic(S_mus_scaler, mus_scaler, sym_scaler);
- }
-
- static Xen g_mus_set_scaler(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_scaler, mus_set_scaler);
- }
-
-
- static Xen g_mus_feedforward(Xen gen)
- {
- #define H_mus_feedforward "(" S_mus_feedforward " gen): gen's feedforward field"
- mus_double_generic(S_mus_feedforward, mus_scaler, sym_feedforward);
- }
-
- static Xen g_mus_set_feedforward(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_feedforward, mus_set_scaler);
- }
-
-
- static Xen g_mus_feedback(Xen gen)
- {
- #define H_mus_feedback "(" S_mus_feedback " gen): gen's " S_mus_feedback " field"
- mus_double_generic(S_mus_feedback, mus_increment, sym_feedback);
- }
-
- static Xen g_mus_set_feedback(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_feedback, mus_set_increment);
- }
-
-
- static Xen g_mus_width(Xen gen)
- {
- #define H_mus_width "(" S_mus_width " gen): gen's width, if any. This is usually a table size."
- mus_double_generic(S_mus_width, mus_width, sym_width);
- }
-
- static Xen g_mus_set_width(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_width, mus_set_width);
- }
-
-
- static Xen g_mus_offset(Xen gen)
- {
- #define H_mus_offset "(" S_mus_offset " gen): gen's offset, if any"
- mus_double_generic(S_mus_offset, mus_offset, sym_offset);
- }
-
- static Xen g_mus_set_offset(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_offset, mus_set_offset);
- }
-
-
- static Xen g_mus_increment(Xen gen)
- {
- #define H_mus_increment "(" S_mus_increment " gen): gen's " S_mus_increment " field, if any"
- mus_double_generic(S_mus_increment, mus_increment, sym_increment);
- }
-
- static Xen g_mus_set_increment(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_increment, mus_set_increment);
- }
-
-
- static Xen g_mus_hop(Xen gen)
- {
- #define H_mus_hop "(" S_mus_hop " gen): gen's " S_mus_hop " field"
- mus_long_long_generic(S_mus_hop, mus_hop);
- }
-
- static Xen g_mus_set_hop(Xen gen, Xen val)
- {
- mus_set_long_long_generic(S_mus_hop, mus_set_hop);
- }
-
-
- static Xen g_mus_ramp(Xen gen)
- {
- #define H_mus_ramp "(" S_mus_ramp " gen): granulate generator's " S_mus_ramp " field"
- mus_long_long_generic(S_mus_ramp, mus_ramp);
- }
-
- static Xen g_mus_set_ramp(Xen gen, Xen val)
- {
- mus_set_long_long_generic(S_mus_ramp, mus_set_ramp);
- }
-
-
- static Xen g_mus_location(Xen gen)
- {
- #define H_mus_location "(" S_mus_location " gen): gen's " S_mus_location " field, if any"
- mus_long_long_generic(S_mus_location, mus_location);
- }
-
- static Xen g_mus_set_location(Xen gen, Xen val)
- {
- mus_set_long_long_generic(S_mus_location, mus_set_location);
- }
-
-
- static Xen g_mus_order(Xen gen)
- {
- #define H_mus_order "(" S_mus_order " gen): gen's order, if any"
- mus_long_long_generic(S_mus_order, mus_length);
- }
-
-
- static Xen g_mus_channel(Xen gen)
- {
- #define H_mus_channel "(" S_mus_channel " gen): gen's " S_mus_channel " field, if any"
- mus_int_generic(S_mus_channel, mus_channel);
- }
-
-
- static Xen g_mus_interp_type(Xen gen)
- {
- #define H_mus_interp_type "(" S_mus_interp_type " gen): gen's " S_mus_interp_type " field, if any"
- mus_int_generic(S_mus_interp_type, mus_channels);
- }
-
-
- static Xen g_mus_type(Xen gen)
- {
- #define H_mus_type "(" S_mus_type " gen): gen's type"
- mus_int_generic(S_mus_type, mus_type);
- }
-
-
- static Xen g_mus_name(Xen gen)
- {
- #define H_mus_name "(" S_mus_name " gen): gen's (type) name, if any"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- return(C_string_to_Xen_string(mus_name(mus_xen_to_mus_any(ms))));
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-name"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_name, "a generator");
- return(gen);
- }
-
-
- Xen g_mus_file_name(Xen gen)
- {
- #define H_mus_file_name "(" S_mus_file_name " gen): file associated with gen, if any"
- mus_xen *gn;
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (gn)
- return(C_string_to_Xen_string(mus_file_name(gn->gen)));
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, S_mus_file_name));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_file_name, "a generator");
- return(gen);
- }
-
-
- Xen g_mus_data(Xen gen)
- {
- #define H_mus_data "(" S_mus_data " gen): gen's internal data (a " S_vct "), if any"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- if (ms->vcts)
- return(ms->vcts[MUS_DATA_WRAPPER]);
- else return(Xen_false);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, S_mus_data));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_data, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_set_data(Xen gen, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- Xen_check_type((mus_is_vct(val)), val, 2, S_set S_mus_data, "a " S_vct);
- if (ms->vcts)
- {
- vct *v;
- mus_any *ma;
- v = Xen_to_vct(val);
- ma = ms->gen;
- mus_set_data(ma, mus_vct_data(v)); /* TO REMEMBER: if allocated, should have freed, and set to not allocated */
- ms->vcts[MUS_DATA_WRAPPER] = val;
- return(val);
- }
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-data"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val)));
- }
- #endif
-
- Xen_check_type(false, gen, 1, S_set S_mus_data, "a generator with a data field");
- return(Xen_false);
- }
-
-
- static Xen c_xcoeffs(mus_xen *ms)
- {
- mus_any *g;
- g = ms->gen;
- if (ms->vcts)
- {
- if (mus_is_polywave(g))
- return(ms->vcts[0]);
- if (ms->nvcts > G_FILTER_XCOEFFS)
- return(ms->vcts[G_FILTER_XCOEFFS]);
- }
- if ((mus_is_one_zero(g)) ||
- (mus_is_one_pole(g)) ||
- (mus_is_two_zero(g)) ||
- (mus_is_two_pole(g)))
- return(xen_make_vct_wrapper(3, mus_xcoeffs(g)));
- return(Xen_false);
- }
-
- static Xen g_mus_xcoeffs(Xen gen)
- {
- #define H_mus_xcoeffs "(" S_mus_xcoeffs " gen): gen's filter xcoeffs (" S_vct " of coefficients on inputs)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms) return(c_xcoeffs(ms));
-
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeffs"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_xcoeffs, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_ycoeffs(Xen gen)
- {
- #define H_mus_ycoeffs "(" S_mus_ycoeffs " gen): gen's filter ycoeffs (" S_vct " of coefficients on outputs)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_any *g;
- g = ms->gen;
- if (ms->vcts)
- {
- if ((mus_is_polywave(Xen_to_mus_any(gen))) && (ms->nvcts == 2))
- return(ms->vcts[1]);
- if (ms->nvcts > G_FILTER_YCOEFFS)
- return(ms->vcts[G_FILTER_YCOEFFS]);
- }
- if ((mus_is_one_zero(g)) ||
- (mus_is_one_pole(g)) ||
- (mus_is_two_zero(g)) ||
- (mus_is_two_pole(g)))
- return(xen_make_vct_wrapper(3, mus_ycoeffs(g)));
- return(Xen_false);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeffs"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_ycoeffs, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_xcoeff(Xen gen, Xen index)
- {
- #define H_mus_xcoeff "(" S_mus_xcoeff " gen index): gen's filter xcoeff value at index (0-based)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- Xen_to_C_integer_or_error(index, ind, S_mus_xcoeff, 2);
- if (ind < 0)
- Xen_out_of_range_error(S_mus_xcoeff, 2, index, "index must be non-negative");
- return(C_double_to_Xen_real(mus_xcoeff(mus_xen_to_mus_any(ms), ind)));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeff"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 2, gen, index)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_xcoeff, "a generator");
- return(index);
- }
-
-
- static Xen g_mus_set_xcoeff(Xen gen, Xen index, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- mus_float_t x;
- Xen_to_C_integer_or_error(index, ind, S_set S_mus_xcoeff, 2);
- Xen_to_C_double_or_error(val, x, S_set S_mus_xcoeff, 3);
- if (ind < 0)
- Xen_out_of_range_error(S_set S_mus_xcoeff, 2, index, "index must be non-negative");
- mus_set_xcoeff(mus_xen_to_mus_any(ms), ind, x);
- return(val);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeff"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 3, gen, index, val)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_set S_mus_xcoeff, "a generator");
- return(val);
- }
-
-
- static Xen g_mus_ycoeff(Xen gen, Xen index)
- {
- #define H_mus_ycoeff "(" S_mus_ycoeff " gen index): gen's filter ycoeff value at index (0-based)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- Xen_to_C_integer_or_error(index, ind, S_mus_ycoeff, 2);
- if (ind < 0)
- Xen_out_of_range_error(S_mus_ycoeff, 2, index, "index must be non-negative");
- return(C_double_to_Xen_real(mus_ycoeff(mus_xen_to_mus_any(ms), ind)));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeff"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 2, gen, index)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_ycoeff, "a generator");
- return(index);
- }
-
-
- static Xen g_mus_set_ycoeff(Xen gen, Xen index, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- mus_float_t x;
- Xen_to_C_integer_or_error(index, ind, S_set S_mus_ycoeff, 2);
- Xen_to_C_double_or_error(val, x, S_set S_mus_ycoeff, 3);
- if (ind < 0)
- Xen_out_of_range_error(S_set S_mus_ycoeff, 2, index, "index must be non-negative");
- mus_set_ycoeff(mus_xen_to_mus_any(ms), ind, x);
- return(val);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeff"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 3, gen, index, val)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_set S_mus_ycoeff, "a generator");
- return(val);
- }
-
-
- Xen g_mus_channels(Xen gen)
- {
- #define H_mus_channels "(" S_mus_channels " gen): gen's " S_mus_channels " field, if any"
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (gn)
- return(C_int_to_Xen_integer(mus_channels(gn->gen)));
-
- #if HAVE_SCHEME
- if (mus_is_vct(gen))
- {
- if (Xen_vector_rank(gen) > 1)
- return(C_int_to_Xen_integer(s7_vector_dimensions(gen)[0]));
- else return(C_int_to_Xen_integer(1));
- }
- #else
- if (mus_is_vct(gen))
- return(C_int_to_Xen_integer(1));
- #endif
-
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-channels"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
-
- Xen_check_type(false, gen, 1, S_mus_channels, "an output generator, " S_vct ", or sound-data object");
- return(Xen_false); /* make compiler happy */
- }
-
-
- Xen g_mus_length(Xen gen)
- {
- #define H_mus_length "(" S_mus_length " gen): gen's length, if any"
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (gn)
- return(C_llong_to_Xen_llong(mus_length(gn->gen)));
-
- if (mus_is_vct(gen))
- return(C_int_to_Xen_integer(mus_vct_length(Xen_to_vct(gen))));
-
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-length"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
-
- Xen_check_type(false, gen, 1, S_mus_length, "a generator, " S_vct ", or sound-data object");
- return(Xen_false); /* make compiler happy */
- }
-
-
- static Xen g_mus_set_length(Xen gen, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_long_t len = 0;
- mus_any *ptr = NULL;
-
- Xen_to_C_integer_or_error(val, len, S_set S_mus_length, 2);
- if (len <= 0)
- Xen_out_of_range_error(S_set S_mus_length, 1, val, "must be > 0");
-
- ptr = ms->gen;
- if ((!mus_is_env(ptr)) && (!mus_is_src(ptr))) /* set length doesn't refer to data vct here */
- {
- if ((ms->vcts) && (!(Xen_is_eq(ms->vcts[MUS_DATA_WRAPPER], Xen_undefined))))
- {
- vct *v;
- v = Xen_to_vct(ms->vcts[MUS_DATA_WRAPPER]);
- if ((v) && (len > mus_vct_length(v)))
- Xen_out_of_range_error(S_set S_mus_length, 1, val, "must be <= current data size");
- /* set_offset refers only to env, set_width only to square_wave et al, set_location only readin */
- /* filters are protected by keeping allocated_size and not allowing arrays to be set */
- }
- }
- mus_set_length(ptr, len);
- return(val);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-length"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_set S_mus_length, "a generator");
- return(val);
- }
-
-
-
-
-
- /* ---------------- oscil ---------------- */
-
- static Xen g_make_oscil(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_oscil "(" S_make_oscil " (frequency *clm-default-frequency*) (initial-phase 0.0)): return a new " S_oscil " (sinewave) generator"
- mus_any *ge;
- mus_float_t freq, phase = 0.0;
-
- freq = clm_default_frequency;
- if (Xen_is_bound(arg1))
- {
- if (!Xen_is_bound(arg2))
- {
- Xen_check_type(Xen_is_number(arg1), arg1, 1, S_make_oscil, "a number");
- freq = Xen_real_to_C_double(arg1);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_oscil, 1, arg1, "freq > srate/2?");
- }
- else
- {
- int vals;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
-
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
- vals = mus_optkey_unscramble(S_make_oscil, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_oscil, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_oscil, orig_arg[0], keys[0], "freq > srate/2?");
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_oscil, orig_arg[1], phase);
- }
- }
- }
-
- ge = mus_make_oscil(freq, phase);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_oscil(Xen osc, Xen fm, Xen pm)
- {
- #define H_oscil "(" S_oscil " gen (fm 0.0) (pm 0.0)): next sample from " S_oscil " gen: val = sin(phase + pm); phase += (freq + fm)"
- #define Q_oscil s7_make_circular_signature(s7, 2, 3, s7_make_symbol(s7, "float?"), s7_make_symbol(s7, S_is_oscil), s7_make_symbol(s7, "real?"))
-
- mus_float_t fm1;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(osc, gn, g, mus_is_oscil, S_oscil, "an oscil");
- if (!Xen_is_bound(fm))
- return(C_double_to_Xen_real(mus_oscil_unmodulated(g)));
- if (!Xen_is_bound(pm))
- return(C_double_to_Xen_real(mus_oscil_fm(g, Xen_real_to_C_double(fm))));
- fm1 = Xen_real_to_C_double(fm);
- if (fm1 == 0.0)
- return(C_double_to_Xen_real(mus_oscil_pm(g, Xen_real_to_C_double(pm))));
- return(C_double_to_Xen_real(mus_oscil(g, fm1, Xen_real_to_C_double(pm))));
- }
-
-
- static Xen g_is_oscil(Xen os)
- {
- #define H_is_oscil "(" S_is_oscil " gen): " PROC_TRUE " if gen is an " S_oscil
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_oscil(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_make_oscil_bank(Xen freqs, Xen phases, Xen amps, XEN stable)
- {
- #define H_make_oscil_bank "(" S_make_oscil_bank " freqs phases amps stable): return a new oscil-bank generator. (freqs in radians)"
-
- mus_any *ge = NULL;
- vct *f, *p, *a = NULL;
- mus_xen *gn;
-
- Xen_check_type(mus_is_vct(freqs), freqs, 1, S_make_oscil_bank, "a " S_vct);
- Xen_check_type(mus_is_vct(phases), phases, 2, S_make_oscil_bank, "a " S_vct);
- Xen_check_type(Xen_is_boolean_or_unbound(stable), stable, 3, S_make_oscil_bank, "a boolean");
-
- f = Xen_to_vct(freqs);
- p = Xen_to_vct(phases);
- if (mus_is_vct(amps)) a = Xen_to_vct(amps);
-
- ge = mus_make_oscil_bank(mus_vct_length(f), mus_vct_data(f), mus_vct_data(p), (a) ? mus_vct_data(a) : NULL, Xen_is_true(stable));
- /* Xen_is_true looks specifically for #t */
-
- gn = mx_alloc(3);
- gn->gen = ge;
- gn->vcts[0] = freqs;
- gn->vcts[1] = phases;
- gn->vcts[2] = amps;
-
- return(mus_xen_to_object(gn));
- }
-
-
- static Xen g_is_oscil_bank(Xen os)
- {
- #define H_is_oscil_bank "(" S_is_oscil_bank " gen): " PROC_TRUE " if gen is an " S_oscil_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_oscil_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_oscil_bank(Xen g)
- {
- #define H_oscil_bank "(" S_oscil_bank " bank): sum an array of oscils"
- mus_any *ob = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(g, gn, ob, mus_is_oscil_bank, S_oscil_bank, "an oscil-bank generator");
- return(C_double_to_Xen_real(mus_oscil_bank(ob)));
- }
-
-
-
-
- /* ---------------- delay ---------------- */
-
-
- typedef enum {G_DELAY, G_COMB, G_NOTCH, G_ALL_PASS, G_FCOMB} xclm_delay_t;
-
- static Xen g_make_delay_1(xclm_delay_t choice, Xen arglist)
- {
- mus_any *ge = NULL, *filt = NULL;
- const char *caller = NULL;
- Xen args[18];
- Xen keys[9];
- Xen xen_filt = Xen_false;
- int orig_arg[9] = {0, 0, 0, 0, 0, 0, 0, (int)MUS_INTERP_NONE, 0};
- int vals, i, argn = 0;
- mus_long_t max_size = -1, size = -1;
- int interp_type = (int)MUS_INTERP_NONE;
- mus_float_t *line = NULL;
- mus_float_t scaler = 0.0, feedback = 0.0, feedforward = 0.0;
- vct *initial_contents = NULL;
- Xen orig_v = Xen_false; /* initial-contents can be a vct */
- mus_float_t initial_element = 0.0;
- int scaler_key = -1, feedback_key = -1, feedforward_key = -1, size_key = -1, initial_contents_key = -1;
- int initial_element_key = -1, max_size_key = -1, interp_type_key = -1, filter_key = -1;
-
- switch (choice)
- {
- case G_DELAY: caller = S_make_delay; break;
- case G_COMB: caller = S_make_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_FCOMB: caller = S_make_filtered_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_NOTCH: caller = S_make_notch; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_ALL_PASS:
- caller = S_make_all_pass;
- feedback_key = argn;
- keys[argn++] = kw_feedback;
- feedforward_key = argn;
- keys[argn++] = kw_feedforward;
- break;
- }
-
- size_key = argn; keys[argn++] = kw_size;
- initial_contents_key = argn; keys[argn++] = kw_initial_contents;
- initial_element_key = argn; keys[argn++] = kw_initial_element;
- max_size_key = argn; keys[argn++] = kw_max_size;
- interp_type_key = argn; keys[argn++] = kw_type;
- filter_key = argn; keys[argn++] = kw_filter;
-
- {
- Xen p;
- int a2, arglist_len;
- a2 = argn * 2;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > a2) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < a2; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, argn, keys, args, orig_arg);
-
- if (vals > 0)
- {
- bool size_set = false, max_size_set = false;
- /* try to catch obvious type/range errors before allocations
- * a major complication here is that size can be 0
- */
-
- if (!(Xen_is_keyword(keys[size_key])))
- {
- size = Xen_optkey_to_mus_long_t(kw_size, keys[size_key], caller, orig_arg[size_key], size); /* size can be 0? -- surely we need a line in any case? */
- if (size < 0)
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size < 0?");
- if (size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size too large (see mus-max-table-size)");
- size_set = true;
- }
-
- if (!(Xen_is_keyword(keys[max_size_key])))
- {
- max_size = Xen_optkey_to_mus_long_t(kw_max_size, keys[max_size_key], caller, orig_arg[max_size_key], max_size); /* -1 = unset */
- if (max_size <= 0)
- Xen_out_of_range_error(caller, orig_arg[max_size_key], keys[max_size_key], "max-size <= 0?");
- if (max_size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[max_size_key], keys[max_size_key], "max-size too large (see mus-max-table-size)");
- max_size_set = true;
- }
-
- if (Xen_is_keyword(keys[interp_type_key]))
- {
- /* if type not given, if max_size, assume linear interp (for possible tap), else no interp */
- if ((max_size_set) && (max_size != size))
- interp_type = (int)MUS_INTERP_LINEAR;
- else interp_type = (int)MUS_INTERP_NONE;
- }
- else
- {
- interp_type = Xen_optkey_to_int(kw_type, keys[interp_type_key], caller, orig_arg[interp_type_key], (int)MUS_INTERP_LINEAR);
- if (!(mus_is_interp_type(interp_type)))
- Xen_out_of_range_error(caller, orig_arg[interp_type_key], keys[interp_type_key], "no such interp-type");
- }
-
- initial_element = Xen_optkey_to_float(kw_initial_element, keys[initial_element_key], caller, orig_arg[initial_element_key], initial_element);
-
- switch (choice)
- {
- case G_DELAY:
- break;
-
- case G_COMB: case G_NOTCH: case G_FCOMB:
- scaler = Xen_optkey_to_float(kw_scaler, keys[scaler_key], caller, orig_arg[scaler_key], scaler);
- break;
-
- case G_ALL_PASS:
- feedback = Xen_optkey_to_float(kw_feedback, keys[feedback_key], caller, orig_arg[feedback_key], feedback);
- feedforward = Xen_optkey_to_float(kw_feedforward, keys[feedforward_key], caller, orig_arg[feedforward_key], feedforward);
- break;
- }
-
- if (!(Xen_is_keyword(keys[filter_key])))
- {
- if (choice != G_FCOMB)
- clm_error(caller, "filter arg passed??", keys[filter_key]);
-
- Xen_check_type(mus_is_xen(keys[filter_key]), keys[filter_key], orig_arg[filter_key], caller, "filter arg must be a generator");
- xen_filt = keys[filter_key];
- filt = Xen_to_mus_any(xen_filt);
- }
-
- if (!(Xen_is_keyword(keys[initial_contents_key])))
- {
- if (!(Xen_is_keyword(keys[initial_element_key])))
- Xen_out_of_range_error(caller,
- orig_arg[initial_contents_key],
- keys[initial_contents_key],
- "initial-contents and initial-element in same call?");
- if (mus_is_vct(keys[initial_contents_key]))
- {
- initial_contents = Xen_to_vct(keys[initial_contents_key]);
- orig_v = keys[initial_contents_key];
- }
- else
- {
- if (Xen_is_list(keys[initial_contents_key]))
- {
- int len;
- len = Xen_list_length(keys[initial_contents_key]);
- if (len <= 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: initial-contents not a proper list?"),
- C_string_to_Xen_string(caller)));
-
- orig_v = xen_list_to_vct(keys[initial_contents_key]);
- initial_contents = Xen_to_vct(orig_v);
- /* do I need to protect this until we read its contents? -- no extlang stuff except error returns */
- }
- else Xen_check_type(Xen_is_false(keys[initial_contents_key]),
- keys[initial_contents_key],
- orig_arg[initial_contents_key],
- caller, "a " S_vct " or a list");
- }
- if (initial_contents)
- {
- if (size_set)
- {
- if (size > mus_vct_length(initial_contents))
- Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "size > initial-contents length");
- }
- else size = mus_vct_length(initial_contents);
- if (max_size_set)
- {
- if (max_size > mus_vct_length(initial_contents))
- Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "max-size > initial-contents length");
- }
- else max_size = mus_vct_length(initial_contents);
- }
- }
- }
- /* here size can be (user-set to) 0, but max_size needs to be a reasonable allocation size */
- if (size < 0) size = 1;
- if (max_size < size)
- {
- if (size == 0)
- max_size = 1;
- else max_size = size;
- }
-
- if (initial_contents == NULL)
- {
- line = (mus_float_t *)malloc(max_size * sizeof(mus_float_t));
- if (line == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate delay line", caller));
- orig_v = xen_make_vct(max_size, line);
- if (initial_element != 0.0)
- {
- for (i = 0; i < max_size; i++)
- line[i] = initial_element;
- }
- else memset((void *)line, 0, max_size * sizeof(mus_float_t));
- }
- else
- {
- line = mus_vct_data(initial_contents);
- }
-
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- switch (choice)
- {
- case G_DELAY: ge = mus_make_delay(size, line, max_size, (mus_interp_t)interp_type); break;
- case G_COMB: ge = mus_make_comb(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_NOTCH: ge = mus_make_notch(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_ALL_PASS: ge = mus_make_all_pass(feedback, feedforward, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_FCOMB: ge = mus_make_filtered_comb(scaler, size, line, max_size, (mus_interp_t)interp_type, filt); break;
- }
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- if (choice != G_FCOMB)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, orig_v, xen_filt)));
- }
- return(clm_mus_error(local_error_type, local_error_msg, caller));
- }
-
-
- static Xen g_make_delay(Xen args)
- {
- #define H_make_delay "(" S_make_delay " (size) (initial-contents) (initial-element 0.0) (max-size) (type mus-interp-linear)): \
- return a new delay line of size elements. \
- If the delay length will be changing at run-time, max-size sets its maximum length, so\n\
- (" S_make_delay " len :max-size (+ len 10))\n\
- provides 10 extra elements of delay for subsequent phasing or flanging. \
- initial-contents can be either a list or a " S_vct "."
-
- if ((Xen_is_pair(args)) && (!Xen_is_pair(Xen_cdr(args))))
- {
- Xen val, v;
- mus_any *ge;
- mus_long_t size, max_size;
- mus_float_t *line;
- mus_error_handler_t *old_error_handler;
-
- val = Xen_car(args);
- Xen_check_type(Xen_is_integer(val), val, 1, S_make_delay, "an integer");
- size = Xen_integer_to_C_int(val);
- if (size < 0)
- Xen_out_of_range_error(S_make_delay, 1, val, "size < 0?");
- if (size > mus_max_table_size())
- Xen_out_of_range_error(S_make_delay, 1, val, "size too large (see mus-max-table-size)");
- if (size == 0) max_size = 1; else max_size = size;
-
- line = (mus_float_t *)calloc(max_size, sizeof(mus_float_t));
- v = xen_make_vct(max_size, line); /* we need this for mus-data */
-
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_delay(size, line, max_size, MUS_INTERP_NONE);
- mus_error_set_handler(old_error_handler);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, v)));
- return(clm_mus_error(local_error_type, local_error_msg, S_make_delay));
- }
-
- return(g_make_delay_1(G_DELAY, args));
- }
-
-
- static Xen g_make_comb(Xen args)
- {
- #define H_make_comb "(" S_make_comb " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
- return a new comb filter (a delay line with a scaler on the feedback) of size elements. \
- If the comb length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_COMB, args));
- }
-
-
- static Xen g_make_filtered_comb(Xen args)
- {
- #define H_make_filtered_comb "(" S_make_filtered_comb " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ") :filter): \
- return a new filtered comb filter (a delay line with a scaler and a filter on the feedback) of size elements. \
- If the comb length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_FCOMB, args));
- }
-
-
- static Xen g_make_notch(Xen args)
- {
- #define H_make_notch "(" S_make_notch " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
- return a new notch filter (a delay line with a scaler on the feedforward) of size elements. \
- If the notch length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_NOTCH, args));
- }
-
-
- static Xen g_make_all_pass(Xen args)
- {
- #define H_make_all_pass "(" S_make_all_pass " (feedback) (feedforward) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
- return a new allpass filter (a delay line with a scalers on both the feedback and the feedforward). \
- If the " S_all_pass " length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_ALL_PASS, args));
- }
-
-
- typedef enum {G_MOVING_AVERAGE, G_MOVING_MAX, G_MOVING_NORM} xclm_moving_t;
-
- static Xen g_make_moving_any(xclm_moving_t choice, const char *caller, Xen arglist)
- {
- mus_any *ge = NULL;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- int vals, i, argn = 0, arglist_len;
- mus_long_t size = -1;
- mus_float_t scaler = 1.0, sum = 0.0;
- vct *initial_contents = NULL;
- Xen orig_v = Xen_false, p;
- mus_float_t initial_element = 0.0;
- mus_float_t *line = NULL;
- int scaler_key = -1, size_key, initial_contents_key, initial_element_key;
- mus_error_handler_t *old_error_handler;
-
- size_key = argn;
- keys[argn++] = kw_size;
- if (choice == G_MOVING_NORM)
- {
- scaler_key = argn;
- keys[argn++] = kw_scaler;
- }
- initial_contents_key = argn;
- keys[argn++] = kw_initial_contents;
- initial_element_key = argn;
- keys[argn++] = kw_initial_element;
-
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 8) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < argn * 2; i++) args[i] = Xen_undefined;
- vals = mus_optkey_unscramble(caller, argn, keys, args, orig_arg);
-
- if (vals > 0)
- {
- bool size_set = false;
- if (!(Xen_is_keyword(keys[size_key])))
- {
- size = Xen_optkey_to_mus_long_t(kw_size, keys[size_key], caller, orig_arg[size_key], size); /* size can be 0? -- surely we need a line in any case? */
- if (size < 0)
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size < 0?");
- if (size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size too large (see mus-max-table-size)");
- size_set = true;
- }
-
- if (choice == G_MOVING_NORM)
- scaler = Xen_optkey_to_float(kw_scaler, keys[scaler_key], caller, orig_arg[scaler_key], scaler);
-
- initial_element = Xen_optkey_to_float(kw_initial_element, keys[initial_element_key], caller, orig_arg[initial_element_key], initial_element);
- if (!(Xen_is_keyword(keys[initial_contents_key])))
- {
- if (!(Xen_is_keyword(keys[initial_element_key])))
- Xen_out_of_range_error(caller,
- orig_arg[initial_contents_key],
- keys[initial_contents_key],
- "initial-contents and initial-element in same call?");
- if (mus_is_vct(keys[initial_contents_key]))
- {
- initial_contents = Xen_to_vct(keys[initial_contents_key]);
- orig_v = keys[initial_contents_key];
- }
- else
- {
- if (Xen_is_list(keys[initial_contents_key]))
- {
- int len;
- len = Xen_list_length(keys[initial_contents_key]);
- if (len <= 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: initial-contents not a proper list?"),
- C_string_to_Xen_string(caller)));
-
- orig_v = xen_list_to_vct(keys[initial_contents_key]);
- initial_contents = Xen_to_vct(orig_v);
- /* do I need to protect this until we read its contents? -- no extlang stuff except error returns */
- }
- else Xen_check_type(Xen_is_false(keys[initial_contents_key]),
- keys[initial_contents_key],
- orig_arg[initial_contents_key],
- caller, "a " S_vct " or a list");
- }
- if (initial_contents)
- {
- if (size_set)
- {
- if (size > mus_vct_length(initial_contents))
- Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "size > initial-contents length");
- }
- else size = mus_vct_length(initial_contents);
- }
- }
- }
-
- if (size < 0) size = 1;
- if (size == 0)
- Xen_out_of_range_error(caller, 0, C_llong_to_Xen_llong(size), "size = 0?");
-
- if (initial_contents == NULL)
- {
- line = (mus_float_t *)malloc(size * sizeof(mus_float_t));
- if (line == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate delay line", caller));
- orig_v = xen_make_vct(size, line);
- if (initial_element != 0.0)
- {
- for (i = 0; i < size; i++)
- line[i] = initial_element;
- sum = initial_element * size;
- }
- else memset((void *)line, 0, size * sizeof(mus_float_t));
- }
- else
- {
- line = mus_vct_data(initial_contents);
- if ((line) && (choice == G_MOVING_AVERAGE))
- {
- sum = line[0];
- for (i = 1; i < size; i++)
- sum += line[i];
- }
- }
-
- old_error_handler = mus_error_set_handler(local_mus_error);
- switch (choice)
- {
- case G_MOVING_AVERAGE: ge = mus_make_moving_average_with_initial_sum(size, line, sum); break;
- case G_MOVING_MAX: ge = mus_make_moving_max(size, line); break;
- case G_MOVING_NORM: ge = mus_make_moving_norm(size, line, scaler); break;
- }
- mus_error_set_handler(old_error_handler);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(clm_mus_error(local_error_type, local_error_msg, caller));
- }
-
-
- static Xen g_make_moving_average(Xen args)
- {
- #define H_make_moving_average "(" S_make_moving_average " (size) (initial-contents) (initial-element 0.0)): \
- return a new moving_average generator. initial-contents can be either a list or a " S_vct "."
-
- return(g_make_moving_any(G_MOVING_AVERAGE, S_make_moving_average, args));
- }
-
-
- static Xen g_make_moving_max(Xen args)
- {
- #define H_make_moving_max "(" S_make_moving_max " (size) (initial-contents) (initial-element 0.0)): \
- return a new moving-max generator. initial-contents can be either a list or a " S_vct "."
-
- return(g_make_moving_any(G_MOVING_MAX, S_make_moving_max, args));
- }
-
-
- static Xen g_make_moving_norm(Xen args)
- {
- #define H_make_moving_norm "(" S_make_moving_norm " (size (scaler 1.0))): return a new moving-norm generator."
-
- return(g_make_moving_any(G_MOVING_NORM, S_make_moving_norm, args));
- }
-
-
- static Xen g_delay(Xen obj, Xen input, Xen pm)
- {
- #define H_delay "(" S_delay " gen (val 0.0) (pm 0.0)): \
- delay val according to the delay line's length and pm ('phase-modulation'). \
- If pm is greater than 0.0, the max-size argument used to create gen should have accommodated its maximum value."
-
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_delay, S_delay, "a delay line");
- if (!Xen_is_bound(input))
- return(C_double_to_Xen_real(mus_delay_unmodulated(g, 0.0)));
- if (!Xen_is_bound(pm))
- return(C_double_to_Xen_real(mus_delay_unmodulated(g, Xen_real_to_C_double(input))));
- return(C_double_to_Xen_real(mus_delay(g, Xen_real_to_C_double(input), Xen_real_to_C_double(pm))));
- }
-
-
- static Xen g_delay_tick(Xen obj, Xen input)
- {
- #define H_delay_tick "(" S_delay_tick " gen (val 0.0)): \
- delay val according to the delay line's length. This merely 'ticks' the delay line forward.\
- The argument 'val' is returned."
-
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_delay, S_delay_tick, "a delay line");
- Xen_real_to_C_double_if_bound(input, in1, S_delay_tick, 2);
-
- return(C_double_to_Xen_real(mus_delay_tick(g, in1)));
- }
-
-
- static Xen g_notch(Xen obj, Xen input, Xen pm)
- {
- #define H_notch "(" S_notch " gen (val 0.0) (pm 0.0)): notch filter val, pm changes the delay length."
-
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_notch, S_notch, "a notch filter");
- Xen_real_to_C_double_if_bound(input, in1, S_notch, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_notch, 3);
-
- return(C_double_to_Xen_real(mus_notch(g, in1, pm1)));
- }
-
-
- static Xen g_comb(Xen obj, Xen input, Xen pm)
- {
- #define H_comb "(" S_comb " gen (val 0.0) (pm 0.0)): comb filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_comb, S_comb, "a comb generator");
- Xen_real_to_C_double_if_bound(input, in1, S_comb, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_comb, 3);
-
- return(C_double_to_Xen_real(mus_comb(g, in1, pm1)));
- }
-
-
- static Xen g_make_comb_bank(Xen arg)
- {
- #define H_make_comb_bank "(" S_make_comb_bank " gens): return a new comb-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
-
- Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_comb_bank, "a vector of comb generators");
-
- size = Xen_vector_length(arg);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(arg, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_comb(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_comb_bank(j, gens);
- free(gens);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
- return(Xen_false);
- }
-
-
- static Xen g_is_comb_bank(Xen os)
- {
- #define H_is_comb_bank "(" S_is_comb_bank " gen): " PROC_TRUE " if gen is a " S_comb_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_comb_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_comb_bank(Xen gens, Xen inp)
- {
- #define H_comb_bank "(" S_comb_bank " bank inval): sum an array of " S_comb " filters."
- mus_any *bank = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_comb_bank, S_comb_bank, "a comb-bank generator");
- Xen_real_to_C_double_if_bound(inp, x, S_comb_bank, 2);
-
- return(C_double_to_Xen_real(mus_comb_bank(bank, x)));
- }
-
-
-
- static Xen g_filtered_comb(Xen obj, Xen input, Xen pm)
- {
- #define H_filtered_comb "(" S_filtered_comb " gen (val 0.0) (pm 0.0)): filtered comb filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_filtered_comb, S_filtered_comb, "a filtered-comb generator");
- Xen_real_to_C_double_if_bound(input, in1, S_filtered_comb, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_filtered_comb, 3);
-
- return(C_double_to_Xen_real(mus_filtered_comb(g, in1, pm1)));
- }
-
-
- static Xen g_make_filtered_comb_bank(Xen arg)
- {
- #define H_make_filtered_comb_bank "(" S_make_filtered_comb_bank " gens): return a new filtered_comb-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
-
- Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_filtered_comb_bank, "a vector of filtered_comb generators");
-
- size = Xen_vector_length(arg);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(arg, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_filtered_comb(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_filtered_comb_bank(j, gens);
- free(gens);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
- return(Xen_false);
- }
-
-
- static Xen g_is_filtered_comb_bank(Xen os)
- {
- #define H_is_filtered_comb_bank "(" S_is_filtered_comb_bank " gen): " PROC_TRUE " if gen is a " S_filtered_comb_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_filtered_comb_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_filtered_comb_bank(Xen gens, Xen inp)
- {
- #define H_filtered_comb_bank "(" S_filtered_comb_bank " bank inval): sum an array of " S_filtered_comb " filters."
- mus_any *bank = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_filtered_comb_bank, S_filtered_comb_bank, "a filtered-comb-bank generator");
- Xen_real_to_C_double_if_bound(inp, x, S_filtered_comb_bank, 2);
-
- return(C_double_to_Xen_real(mus_filtered_comb_bank(bank, x)));
- }
-
-
-
- static Xen g_all_pass(Xen obj, Xen input, Xen pm)
- {
- #define H_all_pass "(" S_all_pass " gen (val 0.0) (pm 0.0)): all-pass filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_all_pass, S_all_pass, "an all-pass filter");
- Xen_real_to_C_double_if_bound(input, in1, S_all_pass, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_all_pass, 3);
-
- return(C_double_to_Xen_real(mus_all_pass(g, in1, pm1)));
- }
-
-
- static Xen g_make_all_pass_bank(Xen arg)
- {
- #define H_make_all_pass_bank "(" S_make_all_pass_bank " gens): return a new all_pass-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
-
- Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_all_pass_bank, "a vector of all_pass generators");
-
- size = Xen_vector_length(arg);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(arg, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_all_pass(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_all_pass_bank(j, gens);
- free(gens);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
- return(Xen_false);
- }
-
-
- static Xen g_is_all_pass_bank(Xen os)
- {
- #define H_is_all_pass_bank "(" S_is_all_pass_bank " gen): " PROC_TRUE " if gen is a " S_all_pass_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_all_pass_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_all_pass_bank(Xen gens, Xen inp)
- {
- #define H_all_pass_bank "(" S_all_pass_bank " bank inval): sum an array of " S_all_pass " filters."
- mus_any *bank = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_all_pass_bank, S_all_pass_bank, "an all-pass-bank generator");
- Xen_real_to_C_double_if_bound(inp, x, S_all_pass_bank, 2);
-
- return(C_double_to_Xen_real(mus_all_pass_bank(bank, x)));
- }
-
-
-
- static Xen g_moving_average(Xen obj, Xen input)
- {
- #define H_moving_average "(" S_moving_average " gen (val 0.0)): moving window average."
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_moving_average, S_moving_average, "a moving-average generator");
- Xen_real_to_C_double_if_bound(input, in1, S_moving_average, 2);
-
- return(C_double_to_Xen_real(mus_moving_average(g, in1)));
- }
-
-
- static Xen g_moving_max(Xen obj, Xen input)
- {
- #define H_moving_max "(" S_moving_max " gen (val 0.0)): moving window max."
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_moving_max, S_moving_max, "a moving-max generator");
- Xen_real_to_C_double_if_bound(input, in1, S_moving_max, 2);
-
- return(C_double_to_Xen_real(mus_moving_max(g, in1)));
- }
-
-
- static Xen g_moving_norm(Xen obj, Xen input)
- {
- #define H_moving_norm "(" S_moving_norm " gen (val 0.0)): moving window norm."
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_moving_norm, S_moving_norm, "a moving-norm generator");
- Xen_real_to_C_double_if_bound(input, in1, S_moving_norm, 2);
-
- return(C_double_to_Xen_real(mus_moving_norm(g, in1)));
- }
-
-
- static Xen g_tap(Xen obj, Xen loc)
- {
- #define H_tap "(" S_tap " gen (pm 0.0)): tap the " S_delay " generator offset by pm"
- mus_float_t dloc = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_tap, S_tap, "a delay line tap");
- Xen_real_to_C_double_if_bound(loc, dloc, S_tap, 3);
-
- return(C_double_to_Xen_real(mus_tap(g, dloc)));
- }
-
-
- static Xen g_is_tap(Xen obj)
- {
- #define H_is_tap "(" S_is_tap " gen): " PROC_TRUE " if gen is a delay line tap"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_tap(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_delay(Xen obj)
- {
- #define H_is_delay "(" S_is_delay " gen): " PROC_TRUE " if gen is a delay line"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_delay(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_comb(Xen obj)
- {
- #define H_is_comb "(" S_is_comb " gen): " PROC_TRUE " if gen is a comb filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_comb(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_filtered_comb(Xen obj)
- {
- #define H_is_filtered_comb "(" S_is_filtered_comb " gen): " PROC_TRUE " if gen is a filtered-comb filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_filtered_comb(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_notch(Xen obj)
- {
- #define H_is_notch "(" S_is_notch " gen): " PROC_TRUE " if gen is a notch filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_notch(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_all_pass(Xen obj)
- {
- #define H_is_all_pass "(" S_is_all_pass " gen): " PROC_TRUE " if gen is an all-pass filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_all_pass(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_moving_average(Xen obj)
- {
- #define H_is_moving_average "(" S_is_moving_average " gen): " PROC_TRUE " if gen is a moving-average generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_average(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_moving_max(Xen obj)
- {
- #define H_is_moving_max "(" S_is_moving_max " gen): " PROC_TRUE " if gen is a moving-max generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_max(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_moving_norm(Xen obj)
- {
- #define H_is_moving_norm "(" S_is_moving_norm " gen): " PROC_TRUE " if gen is a moving-norm generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_norm(Xen_to_mus_any(obj)))));
- }
-
-
- /* -------- ncos -------- */
-
- static Xen g_is_ncos(Xen obj)
- {
- #define H_is_ncos "(" S_is_ncos " gen): " PROC_TRUE " if gen is an " S_ncos " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_ncos(Xen_to_mus_any(obj)))));
- }
-
- static Xen g_make_ncos(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_ncos "(" S_make_ncos " (frequency *clm-default-frequency*) (n 1)): \
- return a new " S_ncos " generator, producing a sum of 'n' equal amplitude cosines."
-
- mus_any *ge;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals, n = 1;
- mus_float_t freq;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_n;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(S_make_ncos, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_ncos, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_ncos, orig_arg[0], keys[0], "freq > srate/2?");
-
- n = Xen_optkey_to_int(kw_n, keys[1], S_make_ncos, orig_arg[1], n);
- if (n <= 0)
- Xen_out_of_range_error(S_make_ncos, orig_arg[1], keys[1], "n <= 0?");
- }
-
- ge = mus_make_ncos(freq, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
- static Xen g_ncos(Xen obj, Xen fm)
- {
- #define H_ncos "(" S_ncos " gen (fm 0.0)): get the next sample from 'gen', an " S_ncos " generator"
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_ncos, S_ncos, "an ncos generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_ncos, 2);
-
- return(C_double_to_Xen_real(mus_ncos(g, fm1)));
- }
-
-
-
- /* -------- nsin -------- */
-
- static Xen g_is_nsin(Xen obj)
- {
- #define H_is_nsin "(" S_is_nsin " gen): " PROC_TRUE " if gen is an " S_nsin " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_nsin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_nsin(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_nsin "(" S_make_nsin " (frequency *clm-default-frequency*) (n 1)): \
- return a new " S_nsin " generator, producing a sum of 'n' equal amplitude sines"
-
- mus_any *ge;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals, n = 1;
- mus_float_t freq;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_n;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(S_make_nsin, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_nsin, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_nsin, orig_arg[0], keys[0], "freq > srate/2?");
-
- n = Xen_optkey_to_int(kw_n, keys[1], S_make_nsin, orig_arg[1], n);
- if (n <= 0)
- Xen_out_of_range_error(S_make_nsin, orig_arg[1], keys[1], "n <= 0?");
- }
-
- ge = mus_make_nsin(freq, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_nsin(Xen obj, Xen fm)
- {
- #define H_nsin "(" S_nsin " gen (fm 0.0)): get the next sample from 'gen', an " S_nsin " generator"
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_nsin, S_nsin, "an nsin generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_nsin, 2);
-
- return(C_double_to_Xen_real(mus_nsin(g, fm1)));
- }
-
-
-
- /* ---------------- rand, rand_interp ---------------- */
-
- #define RANDOM_DISTRIBUTION_TABLE_SIZE 512
- #define RANDOM_DISTRIBUTION_ENVELOPE_SIZE 50
-
- static mus_float_t *inverse_integrate(Xen dist, int data_size)
- {
- /* e = env possibly starting < 0 */
- int e_size = RANDOM_DISTRIBUTION_ENVELOPE_SIZE;
- mus_float_t *e, *data;
- int i, e_len, lim, e_loc = 2;
- Xen ex0, ex1, ey0, ey1;
- mus_float_t x, x0, x1, xincr, y0, y1, sum, first_sum, last_sum = 0.0;
-
- lim = (e_size + 1) * 2;
- e = (mus_float_t *)calloc(lim, sizeof(mus_float_t));
-
- e_len = Xen_list_length(dist);
- ex0 = Xen_list_ref(dist, 0);
- ex1 = Xen_list_ref(dist, e_len - 2);
- x0 = Xen_real_to_C_double(ex0);
- /* get x range first */
- x1 = Xen_real_to_C_double(ex1);
- xincr = (x1 - x0) / (mus_float_t)e_size;
- /* now true x1 */
- ex1 = Xen_list_ref(dist, 2);
- x1 = Xen_real_to_C_double(ex1);
- ey0 = Xen_list_ref(dist, 1);
- ey1 = Xen_list_ref(dist, 3);
- y0 = Xen_real_to_C_double(ey0);
- y1 = Xen_real_to_C_double(ey1);
- sum = y0;
- first_sum = sum;
-
- for (i = 0, x = x0; i < lim; i += 2, x += xincr)
- {
- e[i] = sum;
- last_sum = sum;
- e[i + 1] = x;
- while ((x >= x1) && ((e_loc + 2) < e_len))
- {
- x0 = x1;
- y0 = y1;
- e_loc += 2;
- ex1 = Xen_list_ref(dist, e_loc);
- ey1 = Xen_list_ref(dist, e_loc + 1);
- x1 = Xen_real_to_C_double(ex1);
- y1 = Xen_real_to_C_double(ey1);
- }
- if ((x == x0) || (x0 == x1))
- sum += y0;
- else sum += (y0 + (y1 - y0) * (x - x0) / (x1 - x0));
- }
-
- xincr = (last_sum - first_sum) / (mus_float_t)(data_size - 1);
- data = (mus_float_t *)calloc(data_size, sizeof(mus_float_t));
- x0 = e[0];
- x1 = e[2];
- y0 = e[1];
- y1 = e[3];
- e_len = lim;
- e_loc = 2;
-
- for (i = 0, x = first_sum; i < data_size; i++, x += xincr)
- {
- while ((x >= x1) && ((e_loc + 2) < e_len))
- {
- x0 = x1;
- y0 = y1;
- e_loc += 2;
- x1 = e[e_loc];
- y1 = e[e_loc + 1];
- }
- if ((x == x0) || (x0 == x1))
- data[i] = y0;
- else data[i] = (y0 + (y1 - y0) * (x - x0) / (x1 - x0));
- }
- free(e);
- return(data);
- }
-
-
- static Xen g_make_noi(bool rand_case, const char *caller, Xen arglist)
- {
- mus_any *ge = NULL;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals;
- mus_float_t freq, base = 1.0;
- mus_float_t *distribution = NULL;
- Xen orig_v = Xen_false;
- int distribution_size = RANDOM_DISTRIBUTION_TABLE_SIZE;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_amplitude;
- keys[2] = kw_envelope;
- keys[3] = kw_distribution;
- keys[4] = kw_size;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > mus_srate())
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- base = Xen_optkey_to_float(kw_amplitude, keys[1], caller, orig_arg[1], base);
-
- distribution_size = Xen_optkey_to_int(kw_size, keys[4], caller, orig_arg[4], distribution_size);
- if (distribution_size <= 0)
- Xen_out_of_range_error(caller, orig_arg[4], keys[4], "distribution size <= 0?");
- if (distribution_size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[4], keys[4], "distribution size too large (see mus-max-table-size)");
-
- if (!(Xen_is_keyword(keys[2]))) /* i.e. envelope arg was specified */
- {
- int len;
- Xen_check_type(Xen_is_list(keys[2]), keys[2], orig_arg[2], caller, "an envelope");
- len = Xen_list_length(keys[2]);
- if ((len < 4) || (len & 1))
- clm_error(caller, "bad distribution envelope", keys[2]);
- /* envelope and distribution are incompatible */
- if (!(Xen_is_keyword(keys[3])))
- clm_error(caller, ":envelope and :distribution in same call?", keys[3]);
- distribution = inverse_integrate(keys[2], distribution_size);
- orig_v = xen_make_vct(distribution_size, distribution);
- }
- else
- {
- if (!(Xen_is_keyword(keys[3]))) /* i.e. distribution arg was specified */
- {
- Xen_check_type(mus_is_vct(keys[3]) || Xen_is_false(keys[3]), keys[3], orig_arg[3], caller, "a " S_vct);
- if (mus_is_vct(keys[3]))
- {
- vct *v = NULL;
- orig_v = keys[3];
- v = mus_optkey_to_vct(orig_v, caller, orig_arg[3], NULL);
- distribution_size = mus_vct_length(v);
- distribution = mus_vct_data(v);
- }
- }
- }
- }
- if (!distribution)
- {
- if (rand_case)
- ge = mus_make_rand(freq, base);
- else ge = mus_make_rand_interp(freq, base);
- }
- else
- {
- if (rand_case)
- ge = mus_make_rand_with_distribution(freq, base, distribution, distribution_size);
- else ge = mus_make_rand_interp_with_distribution(freq, base, distribution, distribution_size);
- }
- if (ge)
- {
- if (mus_is_vct(orig_v))
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- }
- return(Xen_false);
- }
-
-
- static Xen g_make_rand_interp(Xen arglist)
- {
- #define H_make_rand_interp "(" S_make_rand_interp " (frequency *clm-default-frequency*) (amplitude 1.0) (envelope) (distribution) (size)): \
- return a new " S_rand_interp " generator, producing linearly interpolated random numbers. \
- frequency is the rate at which new end-points are chosen."
-
- return(g_make_noi(false, S_make_rand_interp, arglist));
- }
-
-
- static Xen g_make_rand(Xen arglist)
- {
- #define H_make_rand "(" S_make_rand " (frequency *clm-default-frequency*) (amplitude 1.0) (envelope) (distribution) (size)): \
- return a new " S_rand " generator, producing a sequence of random numbers (a step function). \
- frequency is the rate at which new numbers are chosen."
-
- return(g_make_noi(true, S_make_rand, arglist));
- }
-
-
- static Xen g_rand(Xen obj, Xen fm)
- {
- #define H_rand "(" S_rand " gen (fm 0.0)): gen's current random number. \
- fm modulates the rate at which the current number is changed."
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rand, S_rand, "a rand generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rand, 2);
-
- return(C_double_to_Xen_real(mus_rand(g, fm1)));
- }
-
-
- static Xen g_is_rand(Xen obj)
- {
- #define H_is_rand "(" S_is_rand " gen): " PROC_TRUE " if gen is a " S_rand
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_rand(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_rand_interp(Xen obj, Xen fm)
- {
- #define H_rand_interp "(" S_rand_interp " gen (fm 0.0)): gen's current (interpolating) random number. \
- fm modulates the rate at which new segment end-points are chosen."
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rand_interp, S_rand_interp, "a rand-interp generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rand_interp, 2);
-
- return(C_double_to_Xen_real(mus_rand_interp(g, fm1)));
- }
-
-
- static Xen g_is_rand_interp(Xen obj)
- {
- #define H_is_rand_interp "(" S_is_rand_interp " gen): " PROC_TRUE " if gen is a " S_rand_interp
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_rand_interp(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_mus_random(Xen a)
- {
- #define H_mus_random "(" S_mus_random " val): a random number between -val and val. \
- the built-in 'random' function returns values between 0 and its argument"
- mus_float_t x;
-
- Xen_to_C_double_or_error(a, x, S_mus_random, 1);
- return(C_double_to_Xen_real(mus_random(x)));
- }
-
-
- static Xen g_mus_rand_seed(void)
- {
- #define H_mus_rand_seed "(" S_mus_rand_seed "): the random number seed; \
- this can be used to re-run a particular random number sequence."
-
- return(C_int_to_Xen_integer(mus_rand_seed()));
- }
-
-
- static Xen g_mus_set_rand_seed(Xen a)
- {
- Xen_check_type(Xen_is_integer(a), a, 1, S_set S_mus_rand_seed, "an integer");
- mus_set_rand_seed((unsigned long)Xen_integer_to_C_int(a));
- return(a);
- }
-
-
-
- /* ---------------- table lookup ---------------- */
-
- static Xen g_is_table_lookup(Xen obj)
- {
- #define H_is_table_lookup "(" S_is_table_lookup " gen): " PROC_TRUE " if gen is a " S_table_lookup
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_table_lookup(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_partials_to_wave(Xen partials, Xen utable, Xen normalize)
- {
- #define H_partials_to_wave "(" S_partials_to_wave " partials wave (normalize " PROC_FALSE ")): \
- take a list or " S_vct " of partials (harmonic number and associated amplitude) and produce \
- a waveform for use in " S_table_lookup ". If wave (a " S_vct ") is not given, \
- a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goes between -1.0 and 1.0.\n\
- (set! gen (" S_make_table_lookup " 440.0 :wave (" S_partials_to_wave " '(1 1.0 2 .5))))"
-
- vct *f;
- Xen table;
- mus_float_t *partial_data = NULL;
- mus_long_t len = 0;
- bool partials_allocated = true;
- #if HAVE_SCHEME
- int gc_loc;
- #endif
-
- Xen_check_type(mus_is_vct(partials) || Xen_is_list(partials), partials, 1, S_partials_to_wave, "a list or a " S_vct);
- Xen_check_type(mus_is_vct(utable) || Xen_is_false(utable) || (!(Xen_is_bound(utable))), utable, 2, S_partials_to_wave, "a " S_vct " or " PROC_FALSE);
- Xen_check_type(Xen_is_boolean_or_unbound(normalize), normalize, 3, S_partials_to_wave, "a boolean");
-
- if (mus_is_vct(partials))
- {
- vct *v;
- v = Xen_to_vct(partials);
- partial_data = mus_vct_data(v);
- len = mus_vct_length(v);
- partials_allocated = false;
- }
- else
- {
- len = Xen_list_length(partials);
- if (len == 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: partials list empty?"),
- C_string_to_Xen_string(S_partials_to_wave)));
-
- if (!(Xen_is_number(Xen_car(partials))))
- Xen_check_type(false, partials, 1, S_partials_to_wave, "a list of numbers (partial numbers with amplitudes)");
- }
- if (len & 1)
- Xen_error(BAD_TYPE,
- Xen_list_3(C_string_to_Xen_string("~A: odd length partials list? ~A"),
- C_string_to_Xen_string(S_partials_to_wave),
- partials));
-
- if ((!Xen_is_bound(utable)) || (!(mus_is_vct(utable))))
- {
- mus_float_t *wave;
- wave = (mus_float_t *)calloc(clm_table_size, sizeof(mus_float_t));
- if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table", S_partials_to_wave));
- table = xen_make_vct(clm_table_size, wave);
- }
- else table = utable;
-
- #if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, table);
- #endif
-
- f = Xen_to_vct(table);
-
- if (!partial_data)
- {
- Xen lst;
- int i;
- partial_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- if (partial_data == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table", S_partials_to_wave));
- for (i = 0, lst = Xen_copy_arg(partials); i < len; i++, lst = Xen_cdr(lst))
- partial_data[i] = Xen_real_to_C_double(Xen_car(lst));
- }
-
- mus_partials_to_wave(partial_data, len / 2, mus_vct_data(f), mus_vct_length(f), (Xen_is_true(normalize)));
-
- if (partials_allocated)
- free(partial_data);
-
- #if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
- #endif
-
- return(table);
- }
-
-
- static Xen g_phase_partials_to_wave(Xen partials, Xen utable, Xen normalize)
- {
- vct *f;
- Xen table;
- mus_float_t *partial_data = NULL;
- mus_long_t len = 0;
- bool partials_allocated = true;
- #if HAVE_SCHEME
- int gc_loc;
- #endif
-
- #if HAVE_SCHEME
- #define pp2w_example "(" S_make_table_lookup " 440.0 :wave (" S_phase_partials_to_wave " (list 1 .75 0.0 2 .25 (* 3.14159 .5))))"
- #endif
- #if HAVE_RUBY
- #define pp2w_example "make_table_lookup(440.0, :wave, phase_partials2wave([1.0, 0.75, 0.0, 2.0, 0.25, 3.14159 * 0.5]))"
- #endif
- #if HAVE_FORTH
- #define pp2w_example "440.0 0.0 '( 1.0 0.75 0.0 2.0 0.25 3.14159 0.5 f* ) #f #f phase-partials->wave make-table-lookup"
- #endif
-
- #define H_phase_partials_to_wave "(" S_phase_partials_to_wave " partials wave (normalize " PROC_FALSE ")): \
- take a list or " S_vct " of partials (harmonic number, amplitude, initial phase) and produce \
- a waveform for use in " S_table_lookup ". If wave (a " S_vct ") is not given, \
- a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goes between -1.0 and 1.0.\n " pp2w_example
-
- Xen_check_type(mus_is_vct(partials) || Xen_is_list(partials), partials, 1, S_phase_partials_to_wave, "a list or a " S_vct);
- Xen_check_type(mus_is_vct(utable) || Xen_is_false(utable) || (!(Xen_is_bound(utable))), utable, 2, S_phase_partials_to_wave, "a " S_vct " or " PROC_FALSE);
- Xen_check_type(Xen_is_boolean_or_unbound(normalize), normalize, 3, S_phase_partials_to_wave, "a boolean");
-
- if (mus_is_vct(partials))
- {
- vct *v;
- v = Xen_to_vct(partials);
- partial_data = mus_vct_data(v);
- len = mus_vct_length(v);
- partials_allocated = false;
- }
- else
- {
- len = Xen_list_length(partials);
- if (len == 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: partials list empty?"),
- C_string_to_Xen_string(S_phase_partials_to_wave)));
-
- if (!(Xen_is_number(Xen_car(partials))))
- Xen_check_type(false, partials, 1, S_phase_partials_to_wave, "a list of numbers (partial numbers with amplitudes and phases)");
- }
- if ((len % 3) != 0)
- Xen_error(Xen_make_error_type("wrong-type-arg"),
- Xen_list_3(C_string_to_Xen_string("~A: partials list, ~A, should have 3 entries for each harmonic (number amp phase)"),
- C_string_to_Xen_string(S_phase_partials_to_wave),
- partials));
-
- if ((!Xen_is_bound(utable)) || (!(mus_is_vct(utable))))
- {
- mus_float_t *wave;
- wave = (mus_float_t *)calloc(clm_table_size, sizeof(mus_float_t));
- if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table", S_phase_partials_to_wave));
- table = xen_make_vct(clm_table_size, wave);
- }
- else table = utable;
-
- #if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, table);
- #endif
-
- f = Xen_to_vct(table);
-
- if (!partial_data)
- {
- int i;
- Xen lst;
- partial_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- if (partial_data == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table", S_phase_partials_to_wave));
- for (i = 0, lst = Xen_copy_arg(partials); i < len; i++, lst = Xen_cdr(lst))
- partial_data[i] = Xen_real_to_C_double(Xen_car(lst));
- }
-
- mus_phase_partials_to_wave(partial_data, len / 3, mus_vct_data(f), mus_vct_length(f), (Xen_is_true(normalize)));
-
- if (partials_allocated)
- free(partial_data);
-
- #if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
- #endif
-
- return(table);
- }
-
-
- static Xen g_make_table_lookup(Xen arglist)
- {
- #define H_make_table_lookup "(" S_make_table_lookup " (frequency *clm-default-frequency*) (initial-phase 0.0) (wave) (size clm-table-size) (type)): \
- return a new " S_table_lookup " generator. \
- The default table size is 512; use :size to set some other size, or pass your own " S_vct " as the 'wave'.\n\
- (set! gen (" S_make_table_lookup " 440.0 :wave (" S_partials_to_wave " '(1 1.0))))\n\
- is the same in effect as " S_make_oscil ". 'type' sets the interpolation choice which defaults to " S_mus_interp_linear "."
-
- mus_any *ge;
- int vals;
- mus_long_t table_size = clm_table_size;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, MUS_INTERP_LINEAR};
- mus_float_t freq, phase = 0.0;
- mus_float_t *table = NULL;
- Xen orig_v = Xen_false;
- int interp_type = (int)MUS_INTERP_LINEAR;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_wave;
- keys[3] = kw_size;
- keys[4] = kw_type;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_table_lookup, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_table_lookup, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v = NULL;
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_table_lookup, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[0], keys[0], "freq > srate/2?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_table_lookup, orig_arg[1], phase);
- if (phase < 0.0)
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[1], keys[1], "initial phase <= 0.0?"); /* is this actually an error? */
-
- v = mus_optkey_to_vct(keys[2], S_make_table_lookup, orig_arg[2], NULL);
- if (v)
- {
- orig_v = keys[2];
- table = mus_vct_data(v);
- table_size = mus_vct_length(v);
- }
-
- table_size = Xen_optkey_to_mus_long_t(kw_size, keys[3], S_make_table_lookup, orig_arg[3], table_size);
- if (table_size <= 0)
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "size <= 0?");
- if (table_size > mus_max_table_size())
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "size too large (see mus-max-table-size)");
- if ((v) && (table_size > mus_vct_length(v)))
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "table size > wave size");
-
- interp_type = Xen_optkey_to_int(kw_type, keys[4], S_make_table_lookup, orig_arg[4], interp_type);
- if (!(mus_is_interp_type(interp_type)))
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[4], keys[4], "no such interp-type");
- }
-
- if (!(mus_is_vct(orig_v)))
- {
- table = (mus_float_t *)calloc(table_size, sizeof(mus_float_t));
- if (table == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate table-lookup table", S_make_table_lookup));
- orig_v = xen_make_vct(table_size, table);
- }
- ge = mus_make_table_lookup(freq, phase, table, table_size, (mus_interp_t)interp_type);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- }
-
-
- static Xen g_table_lookup(Xen obj, Xen fm)
- {
- #define H_table_lookup "(" S_table_lookup " gen (fm 0.0)): interpolated table-lookup \
- with 'wrap-around' when gen's phase marches off either end of its table."
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_table_lookup, S_table_lookup, "a table-lookup generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_table_lookup, 2);
-
- return(C_double_to_Xen_real(mus_table_lookup(g, fm1)));
- }
-
-
-
- /* ---------------- sawtooth et al ---------------- */
-
- typedef enum {G_SAWTOOTH_WAVE, G_SQUARE_WAVE, G_TRIANGLE_WAVE, G_PULSE_TRAIN} xclm_wave_t;
-
- static Xen g_make_sw(xclm_wave_t type, mus_float_t def_phase, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- mus_any *ge = NULL;
- const char *caller = NULL;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- mus_float_t freq, base = 1.0, phase;
-
- freq = clm_default_frequency;
- phase = def_phase;
-
- switch (type)
- {
- case G_SAWTOOTH_WAVE: caller = S_make_sawtooth_wave; break;
- case G_SQUARE_WAVE: caller = S_make_square_wave; break;
- case G_TRIANGLE_WAVE: caller = S_make_triangle_wave; break;
- case G_PULSE_TRAIN: caller = S_make_pulse_train; break;
- }
-
- keys[0] = kw_frequency;
- keys[1] = kw_amplitude;
- keys[2] = kw_initial_phase;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6;
-
- vals = mus_optkey_unscramble(caller, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > mus_srate())
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- base = Xen_optkey_to_float(kw_amplitude, keys[1], caller, orig_arg[1], base);
- phase = Xen_optkey_to_float(kw_initial_phase, keys[2], caller, orig_arg[2], phase);
- }
-
- switch (type)
- {
- case G_SAWTOOTH_WAVE: ge = mus_make_sawtooth_wave(freq, base, phase); break;
- case G_SQUARE_WAVE: ge = mus_make_square_wave(freq, base, phase); break;
- case G_TRIANGLE_WAVE: ge = mus_make_triangle_wave(freq, base, phase); break;
- case G_PULSE_TRAIN: ge = mus_make_pulse_train(freq, base, phase); break;
- }
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_make_sawtooth_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_sawtooth_wave "(" S_make_sawtooth_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_sawtooth_wave " generator."
-
- return(g_make_sw(G_SAWTOOTH_WAVE, M_PI, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_square_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_square_wave "(" S_make_square_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_square_wave " generator."
-
- return(g_make_sw(G_SQUARE_WAVE, 0.0, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_triangle_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_triangle_wave "(" S_make_triangle_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_triangle_wave " generator."
-
- return(g_make_sw(G_TRIANGLE_WAVE, 0.0, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_pulse_train(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_pulse_train "(" S_make_pulse_train " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_pulse_train " generator. This produces a sequence of impulses."
-
- return(g_make_sw(G_PULSE_TRAIN, TWO_PI, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_sawtooth_wave(Xen obj, Xen fm)
- {
- #define H_sawtooth_wave "(" S_sawtooth_wave " gen (fm 0.0)): next sawtooth sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_sawtooth_wave, S_sawtooth_wave, "a sawtooth-wave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_sawtooth_wave, 2);
-
- return(C_double_to_Xen_real(mus_sawtooth_wave(g, fm1)));
- }
-
-
- static Xen g_square_wave(Xen obj, Xen fm)
- {
- #define H_square_wave "(" S_square_wave " gen (fm 0.0)): next square wave sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_square_wave, S_square_wave, "a square-wave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_square_wave, 2);
-
- return(C_double_to_Xen_real(mus_square_wave(g, fm1)));
- }
-
-
- static Xen g_triangle_wave(Xen obj, Xen fm)
- {
- #define H_triangle_wave "(" S_triangle_wave " gen (fm 0.0)): next triangle wave sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_triangle_wave, S_triangle_wave, "a triangle-wave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_triangle_wave, 2);
-
- return(C_double_to_Xen_real(mus_triangle_wave(g, fm1)));
- }
-
-
- static Xen g_pulse_train(Xen obj, Xen fm)
- {
- #define H_pulse_train "(" S_pulse_train " gen (fm 0.0)): next pulse train sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_pulse_train, S_pulse_train, "a pulse-train generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_pulse_train, 2);
-
- return(C_double_to_Xen_real(mus_pulse_train(g, fm1)));
- }
-
-
- static Xen g_is_sawtooth_wave(Xen obj)
- {
- #define H_is_sawtooth_wave "(" S_is_sawtooth_wave " gen): " PROC_TRUE " if gen is a " S_sawtooth_wave
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_sawtooth_wave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_square_wave(Xen obj)
- {
- #define H_is_square_wave "(" S_is_square_wave " gen): " PROC_TRUE " if gen is a " S_square_wave
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_square_wave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_triangle_wave(Xen obj)
- {
- #define H_is_triangle_wave "(" S_is_triangle_wave " gen): " PROC_TRUE " if gen is a " S_triangle_wave
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_triangle_wave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_pulse_train(Xen obj)
- {
- #define H_is_pulse_train "(" S_is_pulse_train " gen): " PROC_TRUE " if gen is a " S_pulse_train
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_pulse_train(Xen_to_mus_any(obj)))));
- }
-
-
-
- /* ---------------- asymmetric-fm ---------------- */
-
- static Xen g_make_asymmetric_fm(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
- {
- #define H_make_asymmetric_fm "(" S_make_asymmetric_fm " (frequency *clm-default-frequency*) (initial-phase 0.0) (r 1.0) (ratio 1.0)): \
- return a new " S_asymmetric_fm " generator."
-
- mus_any *ge;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- int vals;
- mus_float_t freq, phase = 0.0, r = 1.0, ratio = 1.0;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_r;
- keys[3] = kw_ratio;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6; args[6] = arg7; args[7] = arg8;
-
- vals = mus_optkey_unscramble(S_make_asymmetric_fm, 4, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_asymmetric_fm, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_asymmetric_fm, orig_arg[0], keys[0], "freq > srate/2?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_asymmetric_fm, orig_arg[1], phase);
-
- r = Xen_optkey_to_float(kw_r, keys[2], S_make_asymmetric_fm, orig_arg[2], r);
-
- ratio = Xen_optkey_to_float(kw_ratio, keys[3], S_make_asymmetric_fm, orig_arg[3], ratio);
- }
-
- ge = mus_make_asymmetric_fm(freq, phase, r, ratio);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
-
- static Xen g_asymmetric_fm(Xen obj, Xen index, Xen fm)
- {
- #define H_asymmetric_fm "(" S_asymmetric_fm " gen (index 0.0) (fm 0.0)): next sample from asymmetric fm generator"
- mus_float_t fm1 = 0.0, index1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_asymmetric_fm, S_asymmetric_fm, "an asymmetric-fm generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_asymmetric_fm, 2);
- Xen_real_to_C_double_if_bound(index, index1, S_asymmetric_fm, 3);
-
- return(C_double_to_Xen_real(mus_asymmetric_fm(g, index1, fm1)));
- }
-
-
- static Xen g_is_asymmetric_fm(Xen obj)
- {
- #define H_is_asymmetric_fm "(" S_is_asymmetric_fm " gen): " PROC_TRUE " if gen is a " S_asymmetric_fm
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_asymmetric_fm(Xen_to_mus_any(obj)))));
- }
-
-
-
- /* ---------------- simple filters ---------------- */
-
- typedef enum {G_ONE_POLE, G_ONE_ZERO, G_TWO_POLE, G_TWO_ZERO} xclm_filter_t;
-
- static const char *smpflts[6] = {S_make_one_pole, S_make_one_zero, S_make_two_pole, S_make_two_zero};
-
-
- static Xen g_make_smpflt_1(xclm_filter_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- mus_any *gen = NULL;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals;
- mus_float_t a0 = 0.0;
- mus_float_t a1 = 0.0;
-
- switch (choice)
- {
- case G_ONE_ZERO: keys[0] = kw_a0; keys[1] = kw_a1; break;
- case G_ONE_POLE: keys[0] = kw_a0; keys[1] = kw_b1; break;
- default: keys[0] = kw_frequency; keys[1] = kw_radius; break;
- }
-
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
- vals = mus_optkey_unscramble(smpflts[choice], 2, keys, args, orig_arg);
- if (vals > 0)
- {
- a0 = mus_optkey_to_float(keys[0], smpflts[choice], orig_arg[0], a0);
- a1 = mus_optkey_to_float(keys[1], smpflts[choice], orig_arg[1], a1);
- }
-
- switch (choice)
- {
- case G_ONE_ZERO: gen = mus_make_one_zero(a0, a1); break;
- case G_ONE_POLE: gen = mus_make_one_pole(a0, a1); break;
- case G_TWO_ZERO: gen = mus_make_two_zero_from_frequency_and_radius(a0, a1); break;
- case G_TWO_POLE: gen = mus_make_two_pole_from_frequency_and_radius(a0, a1); break;
- default: break;
- }
- if (gen) return(mus_xen_to_object(mus_any_to_mus_xen(gen)));
- return(Xen_false);
- }
-
-
- static Xen g_make_one_zero(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_one_zero "(" S_make_one_zero " a0 a1): return a new " S_one_zero " filter; a0*x(n) + a1*x(n-1)"
- return(g_make_smpflt_1(G_ONE_ZERO, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_make_one_pole(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_one_pole "(" S_make_one_pole " a0 b1): return a new " S_one_pole " filter; a0*x(n) - b1*y(n-1)"
- return(g_make_smpflt_1(G_ONE_POLE, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_make_smpflt_2(xclm_filter_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- mus_any *gen = NULL;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- mus_float_t a0 = 0.0;
- mus_float_t a1 = 0.0;
- mus_float_t a2 = 0.0;
- if (choice == G_TWO_ZERO)
- {
- keys[0] = kw_a0;
- keys[1] = kw_a1;
- keys[2] = kw_a2;
- }
- else
- {
- keys[0] = kw_a0;
- keys[1] = kw_b1;
- keys[2] = kw_b2;
- }
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6;
- vals = mus_optkey_unscramble(smpflts[choice], 3, keys, args, orig_arg);
- if (vals > 0)
- {
- a0 = Xen_optkey_to_float(kw_a0, keys[0], smpflts[choice], orig_arg[0], a0);
- a1 = mus_optkey_to_float(keys[1], smpflts[choice], orig_arg[1], a1);
- a2 = mus_optkey_to_float(keys[2], smpflts[choice], orig_arg[2], a2);
- }
- if (choice == G_TWO_ZERO)
- gen = mus_make_two_zero(a0, a1, a2);
- else gen = mus_make_two_pole(a0, a1, a2);
- if (gen) return(mus_xen_to_object(mus_any_to_mus_xen(gen)));
- return(Xen_false);
- }
-
-
- static bool found_polar_key(Xen arg)
- {
- return((Xen_is_keyword(arg)) &&
- ((Xen_keyword_is_eq(arg, kw_radius)) ||
- (Xen_keyword_is_eq(arg, kw_frequency))));
- }
-
-
- static bool found_coeff_key(Xen arg)
- {
- return((Xen_is_keyword(arg)) &&
- (!(Xen_keyword_is_eq(arg, kw_radius))) &&
- (!(Xen_keyword_is_eq(arg, kw_frequency))));
- }
-
-
- static Xen g_make_two_zero(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_two_zero "(" S_make_two_zero " a0 a1 a2) or (" S_make_two_zero " frequency radius): return a new " S_two_zero " filter; \
- a0*x(n) + a1*x(n-1) + a2*x(n-2)"
-
- if ((Xen_is_bound(arg2)) && /* 0 or 1 args -> coeffs */
- (!(Xen_is_bound(arg5)))) /* 5 or more args -> coeffs */
- {
- if ((found_polar_key(arg1)) ||
- (found_polar_key(arg2)) || /* if arg1 is frequency as number, then arg2 is either key or number */
- ((!(Xen_is_bound(arg3))) && /* make a guess that if 2 args, no keys, and a0 > 20, it is intended as a frequency */
- (!(found_coeff_key(arg1))) &&
- ((Xen_is_number(arg1)) && (Xen_real_to_C_double(arg1) >= 20.0))))
- return(g_make_smpflt_1(G_TWO_ZERO, arg1, arg2, arg3, arg4));
- }
-
- return(g_make_smpflt_2(G_TWO_ZERO, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_two_pole(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_two_pole "(" S_make_two_pole " a0 b1 b2) or (" S_make_two_pole " frequency radius): return a new " S_two_pole " filter; \
- a0*x(n) - b1*y(n-1) - b2*y(n-2)"
-
- if ((Xen_is_bound(arg2)) && /* 0 or 1 args -> coeffs */
- (!(Xen_is_bound(arg5)))) /* 5 or more args -> coeffs */
- {
- if ((found_polar_key(arg1)) ||
- (found_polar_key(arg2)) || /* if arg1 is frequency as number, then arg2 is either key or number */
- ((!(Xen_is_bound(arg3))) &&
- (!(found_coeff_key(arg1))) &&
- ((Xen_is_number(arg1)) && (Xen_real_to_C_double(arg1) >= 2.0))))
- return(g_make_smpflt_1(G_TWO_POLE, arg1, arg2, arg3, arg4));
- }
-
- return(g_make_smpflt_2(G_TWO_POLE, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_one_zero(Xen obj, Xen fm)
- {
- #define H_one_zero "(" S_one_zero " gen (input 0.0)): one zero filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_one_zero, S_one_zero, "a one-zero filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_one_zero, 2);
-
- return(C_double_to_Xen_real(mus_one_zero(g, fm1)));
- }
-
-
- static Xen g_one_pole(Xen obj, Xen fm)
- {
- #define H_one_pole "(" S_one_pole " gen (input 0.0)): one pole filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_one_pole, S_one_pole, "a one-pole filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_one_pole, 2);
-
- return(C_double_to_Xen_real(mus_one_pole(g, fm1)));
- }
-
-
- static Xen g_two_zero(Xen obj, Xen fm)
- {
- #define H_two_zero "(" S_two_zero " gen (input 0.0)): two zero filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_two_zero, S_two_zero, "a two-zero filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_two_zero, 2);
-
- return(C_double_to_Xen_real(mus_two_zero(g, fm1)));
- }
-
-
- static Xen g_two_pole(Xen obj, Xen fm)
- {
- #define H_two_pole "(" S_two_pole " gen (input 0.0)): two pole filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_two_pole, S_two_pole, "a two-pole filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_two_pole, 2);
-
- return(C_double_to_Xen_real(mus_two_pole(g, fm1)));
- }
-
-
- static Xen g_is_one_zero(Xen obj)
- {
- #define H_is_one_zero "(" S_is_one_zero " gen): " PROC_TRUE " if gen is a " S_one_zero
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_one_zero(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_one_pole(Xen obj)
- {
- #define H_is_one_pole "(" S_is_one_pole " gen): " PROC_TRUE " if gen is a " S_one_pole
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_one_pole(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_two_zero(Xen obj)
- {
- #define H_is_two_zero "(" S_is_two_zero " gen): " PROC_TRUE " if gen is a " S_two_zero
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_two_zero(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_two_pole(Xen obj)
- {
- #define H_is_two_pole "(" S_is_two_pole " gen): " PROC_TRUE " if gen is a " S_two_pole
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_two_pole(Xen_to_mus_any(obj)))));
- }
-
-
-
-
- /* ---------------- formant ---------------- */
-
- static Xen g_make_frm(bool formant_case, const char *caller, Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- mus_any *ge;
- int vals;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- mus_float_t freq = 0.0, radius = 0.0;
-
- keys[0] = kw_frequency;
- keys[1] = kw_radius;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(caller, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- radius = Xen_optkey_to_float(kw_radius, keys[1], caller, orig_arg[1], radius);
- }
-
- if (formant_case)
- {
- ge = mus_make_formant(freq, radius);
- if (ge)
- {
- mus_xen *gn;
- gn = mus_any_to_mus_xen(ge);
- return(mus_xen_to_object(gn));
- }
- }
- else
- {
- ge = mus_make_firmant(freq, radius);
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- }
- return(Xen_false);
- }
-
-
- static Xen g_formant(Xen gen, Xen input, Xen freq)
- {
- #define H_formant "(" S_formant " gen (input 0.0) freq-in-radians): next sample from resonator generator"
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_formant, S_formant, "a formant generator");
-
- Xen_real_to_C_double_if_bound(input, in1, S_formant, 2);
- if (Xen_is_bound(freq))
- return(C_double_to_Xen_real(mus_formant_with_frequency(g, in1, Xen_real_to_C_double(freq))));
-
- return(C_double_to_Xen_real(mus_formant(g, in1)));
- }
-
-
- static Xen g_make_formant(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_formant "(" S_make_formant " frequency radius): \
- return a new formant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
- frequency sets the resonance center frequency (Hz)."
-
- return(g_make_frm(true, S_make_formant, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_is_formant(Xen os)
- {
- #define H_is_formant "(" S_is_formant " gen): " PROC_TRUE " if gen is a " S_formant
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_formant(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_set_formant_radius_and_frequency(Xen gen, Xen rad, Xen frq)
- {
- #define H_mus_set_formant_radius_and_frequency "(" S_mus_set_formant_radius_and_frequency " gen radius frequency): set " S_formant " \
- generator gen's radius and frequency"
- mus_any *g = NULL;
- mus_float_t radius, frequency;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_formant, S_mus_set_formant_radius_and_frequency, "a formant generator");
-
- Xen_to_C_double_or_error(rad, radius, S_mus_set_formant_radius_and_frequency, 2);
- Xen_to_C_double_or_error(frq, frequency, S_mus_set_formant_radius_and_frequency, 3);
-
- mus_set_formant_radius_and_frequency(g, radius, frequency);
- return(rad);
- }
-
-
- static Xen g_set_formant_frequency(Xen gen, Xen frq)
- {
- #define H_mus_set_formant_frequency "(" S_mus_set_formant_frequency " gen frequency): set " S_formant " generator gen's frequency"
- mus_any *g = NULL;
- mus_float_t frequency;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_formant, S_mus_set_formant_frequency, "a formant generator");
- Xen_to_C_double_or_error(frq, frequency, S_mus_set_formant_frequency, 2);
-
- mus_set_formant_frequency(g, frequency);
- return(frq);
- }
-
-
- static Xen g_make_formant_bank(Xen frms, Xen amps)
- {
- #define H_make_formant_bank "(" S_make_formant_bank " gens amps): return a new formant-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
- vct *v = NULL;
-
- Xen_check_type(Xen_is_vector(frms), frms, 1, S_make_formant_bank, "a vector of formant generators");
- /* need size and elements -> mus_any */
-
- size = Xen_vector_length(frms);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- if (Xen_is_bound(amps))
- {
- v = Xen_to_vct(amps);
- if (!v) Xen_check_type(false, amps, 2, S_make_formant_bank, "a " S_vct " if anything");
- }
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(frms, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_formant(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_formant_bank(j, gens, (v) ? mus_vct_data(v) : NULL);
- free(gens);
-
- if (ge)
- {
- if (v)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, frms, amps)));
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, frms)));
- }
- return(Xen_false);
- }
-
-
- static Xen g_is_formant_bank(Xen os)
- {
- #define H_is_formant_bank "(" S_is_formant_bank " gen): " PROC_TRUE " if gen is a " S_formant_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_formant_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_formant_bank(Xen gens, Xen inp)
- {
- #define H_formant_bank "(" S_formant_bank " gens inval): sum a bank of " S_formant " generators"
- mus_any *bank = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_formant_bank, S_formant_bank, "a formant-bank generator");
- if (mus_is_vct(inp))
- return(C_double_to_Xen_real(mus_formant_bank_with_inputs(bank, mus_vct_data(Xen_to_vct(inp)))));
-
- if (Xen_is_number(inp))
- return(C_double_to_Xen_real(mus_formant_bank(bank, Xen_real_to_C_double(inp))));
-
- if (!Xen_is_bound(inp))
- return(C_double_to_Xen_real(mus_formant_bank(bank, 0.0)));
-
- Xen_check_type(false, inp, 2, S_formant_bank, "a number or a " S_vct);
- return(Xen_false);
- }
-
-
-
-
- /* ---------------- one-pole-all-pass ---------------- */
-
- static Xen g_make_one_pole_all_pass(Xen arg1, Xen arg2)
- {
- #define H_make_one_pole_all_pass "(" S_make_one_pole_all_pass " size coeff): return a new one-pole-all-pass generator."
-
- mus_any *ge = NULL;
- int size;
- mus_float_t coeff;
-
- Xen_check_type(Xen_is_integer(arg1), arg1, 1, S_make_one_pole_all_pass, "an integer");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(arg2), arg2, 2, S_make_one_pole_all_pass, "a number");
- #endif
-
- size = Xen_integer_to_C_int(arg1);
- if (size < 0)
- Xen_out_of_range_error(S_make_one_pole_all_pass, 1, arg1, "size < 0?");
- if (size == 0) return(Xen_false);
- coeff = Xen_real_to_C_double(arg2);
-
- ge = mus_make_one_pole_all_pass(size, coeff);
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_is_one_pole_all_pass(Xen os)
- {
- #define H_is_one_pole_all_pass "(" S_is_one_pole_all_pass " gen): " PROC_TRUE " if gen is a " S_one_pole_all_pass
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_one_pole_all_pass(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_one_pole_all_pass(Xen gen, Xen fm)
- {
- #define H_one_pole_all_pass "(" S_one_pole_all_pass " gen (input 0.0)): run a one-pole-all-pass generator"
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_one_pole_all_pass, S_one_pole_all_pass, "a one-pole-all-pass generator");
- Xen_real_to_C_double_if_bound(fm, in1, S_one_pole_all_pass, 2);
- return(C_double_to_Xen_real(mus_one_pole_all_pass(g, in1)));
- }
-
-
-
-
- /* ---------------- firmant ---------------- */
-
- static Xen g_make_firmant(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_firmant "(" S_make_firmant " frequency radius): \
- return a new firmant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
- frequency sets the resonance center frequency (Hz)."
-
- return(g_make_frm(false, S_make_firmant, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_is_firmant(Xen os)
- {
- #define H_is_firmant "(" S_is_firmant " gen): " PROC_TRUE " if gen is a " S_firmant " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_firmant(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_firmant(Xen gen, Xen input, Xen freq)
- {
- #define H_firmant "(" S_firmant " gen (input 0.0) freq-in-radians): next sample from resonator generator"
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_firmant, S_firmant, "a firmant generator");
-
- Xen_real_to_C_double_if_bound(input, in1, S_firmant, 2);
- if (Xen_is_bound(freq))
- return(C_double_to_Xen_real(mus_firmant_with_frequency(g, in1, Xen_real_to_C_double(freq))));
-
- return(C_double_to_Xen_real(mus_firmant(g, in1)));
- }
-
-
- static mus_float_t mus_pink_noise(vct *v)
- {
- int i, size;
- mus_float_t sum = 0.0, amp, x;
- mus_float_t *data;
-
- size = mus_vct_length(v);
- data = mus_vct_data(v);
- amp = data[0];
-
- for (i = 2, x = 0.5; i < size; i += 2, x *= 0.5)
- {
- sum += data[i];
- data[i + 1] -= x;
- if (data[i + 1] < 0.0)
- {
- data[i] = mus_random(amp);
- data[i + 1] += 1.0;
- }
- }
- return(sum + mus_random(amp));
- }
-
- #define S_pink_noise "pink-noise"
- static Xen g_pink_noise(Xen gens)
- {
- #define H_pink_noise "(pink-noise gens) generates an approximation to pink noise."
- int size;
- vct *v;
-
- Xen_check_type((mus_is_vct(gens)) && (Xen_vector_rank(gens) == 1), gens, 1, S_pink_noise, "a " S_vct);
- v = Xen_to_vct(gens);
- size = mus_vct_length(v);
- if (size == 0)
- return(XEN_ZERO); /* needs to be upper case for Forth/Ruby */
- Xen_check_type((size & 1) == 0, gens, 1, S_pink_noise, "an even length " S_vct);
-
- return(C_double_to_Xen_real(mus_pink_noise(v)));
- }
-
- #if HAVE_SCHEME
- static s7_double piano_noise(s7_int *g, s7_double noi)
- {
- g[0] = ((g[0] * 1103515245) + 12345) & 0xffffffff;
- noi *= (((s7_double)g[0] * 4.6566128730774e-10) - 1.0);
- return(noi);
- }
-
- #define S_piano_noise "piano-noise"
- static Xen g_piano_noise(Xen gen, XEN amp)
- {
- #define H_piano_noise "(piano-noise gen amp) generates the noise used in the piano instrument."
-
- if (!s7_is_int_vector(gen)) s7_wrong_type_arg_error(s7, S_piano_noise, 1, gen, "an int-vector");
- if (!s7_is_real(amp)) s7_wrong_type_arg_error(s7, S_piano_noise, 2, amp, "a real");
-
- return(C_double_to_Xen_real(piano_noise(s7_int_vector_elements(gen), Xen_real_to_C_double(amp))));
- }
-
-
- #define S_singer_filter "singer-filter"
- static Xen g_singer_filter(Xen start, Xen end, Xen tmp, Xen dline1, Xen dline2, Xen coeffs)
- {
- #define H_singer_filter "this is an optimization for the singer instrument"
- int j, k, beg, lim;
- s7_double *d1, *d2, *cf;
- s7_double temp;
-
- if (!s7_is_integer(start)) s7_wrong_type_arg_error(s7, S_singer_filter, 1, start, "an integer");
- if (!s7_is_integer(end)) s7_wrong_type_arg_error(s7, S_singer_filter, 2, end, "an integer");
- if (!s7_is_real(tmp)) s7_wrong_type_arg_error(s7, S_singer_filter, 3, tmp, "a real");
- if (!s7_is_float_vector(dline1)) s7_wrong_type_arg_error(s7, S_singer_filter, 4, dline1, "a float-vector");
- if (!s7_is_float_vector(dline2)) s7_wrong_type_arg_error(s7, S_singer_filter, 5, dline2, "a float-vector");
- if (!s7_is_float_vector(coeffs)) s7_wrong_type_arg_error(s7, S_singer_filter, 6, coeffs, "a float-vector");
-
- beg = s7_integer(start);
- lim = s7_integer(end);
- d1 = s7_float_vector_elements(dline1);
- d2 = s7_float_vector_elements(dline2);
- cf = s7_float_vector_elements(coeffs);
- temp = s7_number_to_real(s7, tmp);
-
- for (k = beg, j = beg + 1; j < lim; k++, j++)
- {
- s7_double temp1, x;
- x = d2[j + 1];
- d2[j] = x + (cf[j] * (d1[k] - x));
- temp1 = temp;
- temp = d1[k] + d2[j] - x;
- d1[k] = temp1;
- }
- return(s7_make_real(s7, temp));
- }
-
-
- #define S_singer_nose_filter "singer-nose-filter"
- static Xen g_singer_nose_filter(Xen end, Xen tmp, Xen dline1, Xen dline2, Xen coeffs)
- {
- #define H_singer_nose_filter "this is an optimization for the singer instrument"
- int j, k, lim;
- s7_double *d1, *d2, *cf;
- s7_double temp;
-
- if (!s7_is_integer(end)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 1, end, "an integer");
- if (!s7_is_real(tmp)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 2, tmp, "a real");
- if (!s7_is_float_vector(dline1)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 3, dline1, "a float-vector");
- if (!s7_is_float_vector(dline2)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 4, dline2, "a float-vector");
- if (!s7_is_float_vector(coeffs)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 5, coeffs, "a float-vector");
-
- lim = s7_integer(end);
- d1 = s7_float_vector_elements(dline1);
- d2 = s7_float_vector_elements(dline2);
- cf = s7_float_vector_elements(coeffs);
- temp = s7_number_to_real(s7, tmp);
-
- for (k = 1, j = 2; j < lim; k++, j++)
- {
- s7_double t1, reftemp;
- reftemp = cf[j] * (d1[k] - d2[j + 1]);
- d2[j] = d2[j + 1] + reftemp;
- t1 = temp;
- temp = d1[k] + reftemp;
- d1[k] = t1;
- }
-
- return(s7_make_real(s7, temp));
- }
-
- #endif
-
-
-
- /* ---------------- wave-train ---------------- */
-
- static Xen g_make_wave_train(Xen arglist)
- {
- #define H_make_wave_train "(" S_make_wave_train " (frequency *clm-default-frequency*) (initial-phase 0.0) (wave) (size clm-table-size) (type)): \
- return a new wave-train generator (an extension of pulse-train). Frequency is \
- the repetition rate of the wave found in wave. Successive waves can overlap."
-
- mus_any *ge;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, MUS_INTERP_LINEAR};
- int vals;
- mus_long_t wsize = clm_table_size;
- Xen orig_v = Xen_false;
- mus_float_t freq, phase = 0.0;
- mus_float_t *wave = NULL;
- int interp_type = (int)MUS_INTERP_LINEAR;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_wave;
- keys[3] = kw_size;
- keys[4] = kw_type;
-
- {
- Xen p;
- int i, arglist_len;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_wave_train, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_wave_train, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v = NULL;
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_wave_train, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_wave_train, orig_arg[0], keys[0], "freq > srate/2?");
- if (freq < 0.0)
- Xen_out_of_range_error(S_make_wave_train, orig_arg[0], keys[0], "freq < 0.0?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_wave_train, orig_arg[1], phase);
- if (phase < 0.0)
- Xen_out_of_range_error(S_make_wave_train, orig_arg[1], keys[1], "phase < 0.0?");
-
- v = mus_optkey_to_vct(keys[2], S_make_wave_train, orig_arg[2], NULL);
- if (v)
- {
- orig_v = keys[2];
- wave = mus_vct_data(v);
- wsize = mus_vct_length(v);
- }
-
- wsize = Xen_optkey_to_mus_long_t(kw_size, keys[3], S_make_wave_train, orig_arg[3], wsize);
- if (wsize <= 0)
- Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "size <= 0?");
- if (wsize > mus_max_table_size())
- Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "size too large (see mus-max-table-size)");
- if ((v) && (wsize > mus_vct_length(v)))
- Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "table size > wave size");
-
- interp_type = Xen_optkey_to_int(kw_type, keys[4], S_make_wave_train, orig_arg[4], interp_type);
- if (!(mus_is_interp_type(interp_type)))
- Xen_out_of_range_error(S_make_wave_train, orig_arg[4], keys[4], "no such interp-type");
- }
-
- if (wave == NULL)
- {
- wave = (mus_float_t *)calloc(wsize, sizeof(mus_float_t));
- if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave-train table", S_make_wave_train));
- orig_v = xen_make_vct(wsize, wave);
- }
- ge = mus_make_wave_train(freq, phase, wave, wsize, (mus_interp_t)interp_type);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- }
-
-
- static Xen g_wave_train(Xen obj, Xen fm)
- {
- #define H_wave_train "(" S_wave_train " gen (fm 0.0)): next sample of " S_wave_train
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_wave_train, S_wave_train, "a wave-train generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_wave_train, 2);
-
- return(C_double_to_Xen_real(mus_wave_train(g, fm1)));
- }
-
-
- static Xen g_is_wave_train(Xen obj)
- {
- #define H_is_wave_train "(" S_is_wave_train " gen): " PROC_TRUE " if gen is a " S_wave_train
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_wave_train(Xen_to_mus_any(obj)))));
- }
-
-
-
- /* ---------------- waveshaping ---------------- */
-
- enum {NO_PROBLEM_IN_LIST, NULL_LIST, ODD_LENGTH_LIST, NON_NUMBER_IN_LIST, NEGATIVE_NUMBER_IN_LIST, HUGE_NUMBER_IN_LIST};
-
- static const char *list_to_partials_error_to_string(int code)
- {
- switch (code)
- {
- case NO_PROBLEM_IN_LIST: return("~A: nothing wrong with partials list?? ~A"); break;
- case NULL_LIST: return("~A: partials list is null, ~A"); break;
- case ODD_LENGTH_LIST: return("~A: partials list has an odd number of elements: ~A"); break;
- case NON_NUMBER_IN_LIST: return("~A: partials list has a non-numerical element: ~A"); break;
- case NEGATIVE_NUMBER_IN_LIST: return("~A: partials list has a partial number that is negative: ~A"); break;
- case HUGE_NUMBER_IN_LIST: return("~A: partials list has a partial number that is too large: ~A"); break;
- }
- return("~A: unknown error, ~A");
- }
-
-
- static mus_float_t *list_to_partials(Xen harms, int *npartials, int *error_code)
- {
- int listlen, i, maxpartial = 0, curpartial;
- mus_float_t *partials = NULL;
- Xen lst;
-
- listlen = Xen_list_length(harms);
- if (listlen == 0)
- {
- (*error_code) = NULL_LIST;
- return(NULL);
- }
-
- if (listlen & 1)
- {
- (*error_code) = ODD_LENGTH_LIST;
- return(NULL);
- }
-
- if (!(Xen_is_number(Xen_car(harms))))
- {
- (*error_code) = NON_NUMBER_IN_LIST;
- return(NULL);
- }
- /* the list is '(partial-number partial-amp ... ) */
- (*error_code) = NO_PROBLEM_IN_LIST;
-
- for (i = 0, lst = Xen_copy_arg(harms); i < listlen; i += 2, lst = Xen_cddr(lst))
- {
- if ((!(Xen_is_integer(Xen_car(lst)))) ||
- (!(Xen_is_number(Xen_cadr(lst)))))
- {
- (*error_code) = NON_NUMBER_IN_LIST;
- return(NULL);
- }
- curpartial = Xen_integer_to_C_int(Xen_car(lst));
- if (curpartial < 0)
- {
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- return(NULL);
- }
- if (curpartial > maxpartial)
- maxpartial = curpartial;
- }
-
- if (maxpartial > 10000000)
- {
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- return(NULL);
- }
-
- partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
- /* here and elsewhere? this won't be null until we touch it in linux, but that gloms up all our
- * code with once-in-a-billion-years error checks.
- */
- if (partials == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
- (*npartials) = maxpartial + 1;
-
- for (i = 0, lst = Xen_copy_arg(harms); i < listlen; i += 2, lst = Xen_cddr(lst))
- {
- curpartial = Xen_integer_to_C_int(Xen_car(lst));
- partials[curpartial] = (mus_float_t)Xen_real_to_C_double(Xen_cadr(lst));
- }
- return(partials);
- }
-
-
- static mus_float_t *mus_vct_to_partials(vct *v, int *npartials, int *error_code)
- {
- int len, i, maxpartial, curpartial;
- mus_float_t *partials = NULL, *vdata;
-
- len = mus_vct_length(v);
- if (len == 0)
- {
- (*error_code) = NULL_LIST;
- return(NULL);
- }
- if (len & 1)
- {
- (*error_code) = ODD_LENGTH_LIST;
- return(NULL);
- }
- (*error_code) = NO_PROBLEM_IN_LIST;
-
- vdata = mus_vct_data(v);
- maxpartial = (int)(vdata[0]);
- if (maxpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- else
- {
- for (i = 2; i < len; i += 2)
- {
- curpartial = (int)(vdata[i]);
- if (curpartial > maxpartial)
- maxpartial = curpartial;
- if (curpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- }
- }
- if ((*error_code) != NO_PROBLEM_IN_LIST)
- return(NULL);
-
- partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
- if (partials == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
- (*npartials) = maxpartial + 1;
-
- for (i = 0; i < len; i += 2)
- {
- curpartial = (int)(vdata[i]);
- partials[curpartial] = vdata[i + 1];
- }
- return(partials);
- }
-
-
- static mus_float_t *mus_vector_to_partials(Xen v, int *npartials, int *error_code)
- {
- int len, i, maxpartial, curpartial;
- mus_float_t *partials = NULL;
-
- len = Xen_vector_length(v);
- if (len == 0)
- {
- (*error_code) = NULL_LIST;
- return(NULL);
- }
- if (len & 1)
- {
- (*error_code) = ODD_LENGTH_LIST;
- return(NULL);
- }
- (*error_code) = NO_PROBLEM_IN_LIST;
-
- maxpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, 0)));
- if (maxpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- else
- {
- for (i = 2; i < len; i += 2)
- {
- curpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, i)));
- if (curpartial > maxpartial)
- maxpartial = curpartial;
- if (curpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- }
- }
- if ((*error_code) != NO_PROBLEM_IN_LIST)
- return(NULL);
-
- partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
- if (partials == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
- (*npartials) = maxpartial + 1;
-
- for (i = 0; i < len; i += 2)
- {
- curpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, i)));
- partials[curpartial] = Xen_real_to_C_double(Xen_vector_ref(v, i + 1));
- }
- return(partials);
- }
-
-
- static Xen g_partials_to_polynomial(Xen amps, Xen ukind)
- {
- #if HAVE_SCHEME
- #define p2p_example "(let ((v0 (partials->polynomial '(1 1.0 2 1.0)))\n (os (make-oscil)))\n (polynomial v0 (oscil os)))"
- #endif
- #if HAVE_RUBY
- #define p2p_example "v0 = partials2polynomial([1, 1.0, 2, 1.0])\n os = make_oscil()\n polynomial(v0, oscil(os))"
- #endif
- #if HAVE_FORTH
- #define p2p_example "'( 1 1.0 2 1.0 ) partials->polynomial value v0\n make-oscil value os\n v0 os 0.0 0.0 oscil polynomial"
- #endif
-
- #define H_partials_to_polynomial "(" S_partials_to_polynomial " partials (kind " S_mus_chebyshev_first_kind ")): \
- produce a Chebyshev polynomial suitable for use with the " S_polynomial " generator \
- to create (via waveshaping) the harmonic spectrum described by the partials argument:\n " p2p_example
-
- int npartials = 0;
- mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
- mus_float_t *partials = NULL, *wave;
- int error = NO_PROBLEM_IN_LIST;
-
- Xen_check_type(mus_is_vct(amps) || Xen_is_list(amps), amps, 1, S_partials_to_polynomial, "a list or a " S_vct);
- Xen_check_type(Xen_is_integer_or_unbound(ukind), ukind, 2, S_partials_to_polynomial, "either " S_mus_chebyshev_first_kind " or " S_mus_chebyshev_second_kind);
-
- if (Xen_is_integer(ukind))
- {
- int ck;
- ck = Xen_integer_to_C_int(ukind);
- if ((ck >= MUS_CHEBYSHEV_EITHER_KIND) && (ck <= MUS_CHEBYSHEV_SECOND_KIND))
- kind = (mus_polynomial_t)ck;
- else Xen_out_of_range_error(S_partials_to_polynomial, 2, ukind, "unknown Chebyshev polynomial kind");
- }
-
- if (mus_is_vct(amps))
- partials = mus_vct_to_partials(Xen_to_vct(amps), &npartials, &error);
- else partials = list_to_partials(amps, &npartials, &error);
-
- if (partials == NULL)
- Xen_error(NO_DATA,
- Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
- C_string_to_Xen_string(S_partials_to_polynomial),
- amps));
-
- wave = mus_partials_to_polynomial(npartials, partials, kind); /* wave == partials; in both vct and list cases, partials is newly allocated */
- return(xen_make_vct(npartials, wave));
- }
-
-
- static Xen g_normalize_partials(Xen partials)
- {
- #define H_normalize_partials "(" S_normalize_partials " partials) scales the \
- partial amplitudes in the " S_vct " or list 'partials' by the inverse of their sum (so that they add to 1.0)."
-
- vct *v;
- Xen xv = Xen_false;
-
- Xen_check_type(((Xen_is_list(partials)) && (!Xen_is_null(partials))) || (mus_is_vct(partials)), partials, 1, S_normalize_partials, "a " S_vct " or (non-empty) list");
-
- if (mus_is_vct(partials))
- xv = partials;
- else xv = xen_list_to_vct(partials);
- v = Xen_to_vct(xv);
-
- if ((mus_vct_length(v) > 1) &&
- ((mus_vct_length(v) & 1) == 0))
- mus_normalize_partials(mus_vct_length(v) / 2, mus_vct_data(v));
- else Xen_error(BAD_TYPE,
- Xen_list_3(C_string_to_Xen_string("~A: partials, ~A, must be a non-empty list or " S_vct " of even length (partial-number partial-amp ...)"),
- C_string_to_Xen_string(S_normalize_partials),
- partials));
- return(xv);
- }
-
-
- static mus_float_t *vector_to_float_array(Xen v)
- {
- mus_float_t *data;
- mus_long_t i, len;
- len = Xen_vector_length(v);
- data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- for (i = 0; i < len; i++)
- data[i] = Xen_real_to_C_double(Xen_vector_ref(v, i));
- return(data);
- }
-
- static Xen g_chebyshev_tu_sum(Xen x, Xen tn, Xen un)
- {
- #define H_chebyshev_tu_sum "(" S_mus_chebyshev_tu_sum " x tn un) returns the sum of the weighted\
- Chebyshev polynomials Tn and Un (vectors or " S_vct "s), with phase x."
-
- bool need_free = false;
- int len = 0;
- mus_float_t *tdata = NULL, *udata = NULL;
- Xen result;
-
- Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_tu_sum, "a float");
-
- if ((mus_is_vct(tn)) &&
- (mus_is_vct(un)))
- {
- vct *Tn, *Un;
- Tn = Xen_to_vct(tn);
- tdata = mus_vct_data(Tn);
- Un = Xen_to_vct(un);
- udata = mus_vct_data(Un);
- len = mus_vct_length(Tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- if (len != mus_vct_length(Un)) return(C_double_to_Xen_real(0.0));
- }
- else
- {
- if ((Xen_is_vector(tn)) &&
- (Xen_is_vector(un)))
- {
- len = Xen_vector_length(tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- if (len != Xen_vector_length(un)) return(C_double_to_Xen_real(0.0));
- tdata = vector_to_float_array(tn);
- udata = vector_to_float_array(un);
- need_free = true;
- }
- else
- {
- Xen_check_type(false, tn, 1, S_mus_chebyshev_tu_sum, "both arrays should be either " S_vct "s or vectors");
- }
- }
-
- result = C_double_to_Xen_real(mus_chebyshev_tu_sum(Xen_real_to_C_double(x), len, tdata, udata));
- if (need_free)
- {
- free(tdata);
- free(udata);
- }
-
- return(result);
- }
-
-
- static Xen g_chebyshev_t_sum(Xen x, Xen tn)
- {
- #define H_chebyshev_t_sum "(" S_mus_chebyshev_t_sum " x tn) returns the sum of the weighted \
- Chebyshev polynomials Tn (a " S_vct ")."
-
- bool need_free = false;
- int len = 0;
- mus_float_t *data = NULL;
- Xen result;
-
- Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_t_sum, "a float");
- if (mus_is_vct(tn))
- {
- vct *Tn;
- Tn = Xen_to_vct(tn);
- data = mus_vct_data(Tn);
- len = mus_vct_length(Tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- }
- else
- {
- if (Xen_is_vector(tn))
- {
- len = Xen_vector_length(tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- data = vector_to_float_array(tn);
- need_free = true;
- }
- else Xen_check_type(false, tn, 1, S_mus_chebyshev_t_sum, "a " S_vct " or a vector");
- }
- result = C_double_to_Xen_real(mus_chebyshev_t_sum(Xen_real_to_C_double(x), len, data));
- if (need_free)
- free(data);
- return(result);
- }
-
-
- static Xen g_chebyshev_u_sum(Xen x, Xen un)
- {
- #define H_chebyshev_u_sum "(" S_mus_chebyshev_u_sum " x un) returns the sum of the weighted \
- Chebyshev polynomials Un (a " S_vct ")."
-
- bool need_free = false;
- int len = 0;
- mus_float_t *data = NULL;
- Xen result;
-
- Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_u_sum, "a float");
-
- if (mus_is_vct(un))
- {
- vct *Un;
- Un = Xen_to_vct(un);
- len = mus_vct_length(Un);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- data = mus_vct_data(Un);
- }
- else
- {
- if (Xen_is_vector(un))
- {
- len = Xen_vector_length(un);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- data = vector_to_float_array(un);
- need_free = true;
- }
- else Xen_check_type(false, un, 1, S_mus_chebyshev_u_sum, "a " S_vct " or a vector");
- }
- result = C_double_to_Xen_real(mus_chebyshev_u_sum(Xen_real_to_C_double(x), len, data));
- if (need_free)
- free(data);
- return(result);
- }
-
-
-
-
- /* ---------------- polyshape ---------------- */
-
- static Xen g_polyshape(Xen obj, Xen index, Xen fm)
- {
- #define H_polyshape "(" S_polyshape " gen (index 1.0) (fm 0.0)): next sample of polynomial-based waveshaper"
- mus_float_t fm1 = 0.0, index1 = 1.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_polyshape, S_polyshape, "a polyshape generator");
- Xen_real_to_C_double_if_bound(index, index1, S_polyshape, 2);
- Xen_real_to_C_double_if_bound(fm, fm1, S_polyshape, 3);
-
- return(C_double_to_Xen_real(mus_polyshape(g, index1, fm1)));
- }
-
-
- static Xen g_is_polyshape(Xen obj)
- {
- #define H_is_polyshape "(" S_is_polyshape " gen): " PROC_TRUE " if gen is a " S_polyshape
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_polyshape(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_polyshape(Xen arglist)
- {
- #define H_make_polyshape "(" S_make_polyshape " (frequency *clm-default-frequency*) (initial-phase 0.0) (coeffs) (partials '(1 1)) (kind " S_mus_chebyshev_first_kind ")): \
- return a new polynomial-based waveshaping generator:\n\
- (" S_make_polyshape " :coeffs (" S_partials_to_polynomial " '(1 1.0)))\n\
- is the same in effect as " S_make_oscil
-
- mus_any *ge;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals, csize = 0, npartials = 0;
- Xen orig_v = Xen_false;
- mus_float_t freq, phase = 0.0;
- /*
- * if we followed the definition directly, the initial phase default would be M_PI_2 (pi/2) so that
- * we drive the Tn's with a cosine. But I've always used sine instead, so I think I'll leave
- * it that way. There is no difference in the output waveform except an overall phase
- * offset. So, with sine, the phases rotate through cos sin -cos -sin... rather than being all cos,
- * but these add to exactly the same actual wave -- what you'd expect since Tn doesn't know
- * where we started. This also does not affect "signification".
- */
- mus_float_t *coeffs = NULL;
-
- mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_coeffs;
- keys[3] = kw_partials;
- keys[4] = kw_kind;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_polyshape, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_polyshape, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v = NULL;
- int ck;
-
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_polyshape, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_polyshape, orig_arg[0], keys[0], "freq > srate/2?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_polyshape, orig_arg[2], phase);
-
- ck = Xen_optkey_to_int(kw_kind, keys[4], S_make_polyshape, orig_arg[4], (int)kind);
- if ((ck >= MUS_CHEBYSHEV_EITHER_KIND) && (ck <= MUS_CHEBYSHEV_SECOND_KIND))
- kind = (mus_polynomial_t)ck;
- else Xen_out_of_range_error(S_make_polyshape, orig_arg[4], keys[4], "unknown Chebyshev polynomial kind");
-
- v = mus_optkey_to_vct(keys[2], S_make_polyshape, orig_arg[2], NULL);
- if (v)
- {
- orig_v = keys[2];
- coeffs = mus_vct_data(v);
- csize = mus_vct_length(v);
- }
- else
- {
- if (!(Xen_is_keyword(keys[3])))
- {
- mus_float_t *partials = NULL;
- int error = NO_PROBLEM_IN_LIST;
- if (mus_is_vct(keys[3]))
- partials = mus_vct_to_partials(Xen_to_vct(keys[3]), &npartials, &error);
- else
- {
- Xen_check_type(Xen_is_list(keys[3]), keys[3], orig_arg[3], S_make_polyshape, "a list or a " S_vct);
- partials = list_to_partials(keys[3], &npartials, &error);
- }
- if (partials == NULL)
- Xen_error(NO_DATA,
- Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
- C_string_to_Xen_string(S_make_polyshape),
- keys[3]));
- coeffs = mus_partials_to_polynomial(npartials, partials, kind);
- csize = npartials;
- /* coeffs = partials here, so don't delete */
- }
- }
- }
-
- if (!coeffs)
- {
- /* clm.html says '(1 1) is the default */
- mus_float_t *data;
- data = (mus_float_t *)malloc(2 * sizeof(mus_float_t));
- data[0] = 0.0;
- data[1] = 1.0;
- coeffs = mus_partials_to_polynomial(2, data, kind);
- csize = 2;
- }
-
- if (Xen_is_false(orig_v))
- orig_v = xen_make_vct(csize, coeffs);
-
- ge = mus_make_polyshape(freq, phase, coeffs, csize, kind);
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(Xen_false);
- }
-
-
-
- /* ---------------- polywave ---------------- */
-
- static Xen g_polywave(Xen obj, Xen fm)
- {
- #define H_polywave "(" S_polywave " gen (fm 0.0)): next sample of polywave waveshaper"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_polywave, S_polywave, "a polywave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_polywave, 3);
-
- return(C_double_to_Xen_real(mus_polywave(g, fm1)));
- }
-
-
- static Xen g_is_polywave(Xen obj)
- {
- #define H_is_polywave "(" S_is_polywave " gen): " PROC_TRUE " if gen is a " S_polywave " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_polywave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_polywave(Xen arglist)
- {
- #define H_make_polywave "(" S_make_polywave " (frequency *clm-default-frequency*) (partials '(1 1)) (type " S_mus_chebyshev_first_kind ") xcoeffs ycoeffs): \
- return a new polynomial-based waveshaping generator. (" S_make_polywave " :partials (float-vector 1 1.0)) is the same in effect as " S_make_oscil "."
-
- mus_any *ge;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals, n = 0, npartials = 0;
- Xen orig_x = Xen_false, orig_y = Xen_false;
- mus_float_t freq;
- mus_float_t *xcoeffs = NULL, *ycoeffs = NULL, *partials = NULL;
- mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
- int error = NO_PROBLEM_IN_LIST;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_partials;
- keys[2] = kw_type;
- keys[3] = kw_x_coeffs;
- keys[4] = kw_y_coeffs;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_polywave, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_polywave, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v;
- int type;
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_polywave, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_polywave, orig_arg[0], keys[0], "freq > srate/2?");
-
- type = Xen_optkey_to_int(kw_type, keys[2], S_make_polywave, orig_arg[2], (int)kind);
- if ((type >= MUS_CHEBYSHEV_EITHER_KIND) &&
- (type <= MUS_CHEBYSHEV_BOTH_KINDS))
- kind = (mus_polynomial_t)type;
- else Xen_out_of_range_error(S_make_polywave, orig_arg[2], keys[2], "unknown Chebyshev polynomial kind");
-
- if (!(Xen_is_keyword(keys[1]))) /* partials were supplied */
- {
- if (mus_is_vct(keys[1]))
- partials = mus_vct_to_partials(Xen_to_vct(keys[1]), &npartials, &error);
- else
- {
- if (Xen_is_vector(keys[1]))
- partials = mus_vector_to_partials(keys[1], &npartials, &error);
- else
- {
- Xen_check_type(Xen_is_list(keys[1]), keys[1], orig_arg[1], S_make_polywave, "a list or a " S_vct);
- partials = list_to_partials(keys[1], &npartials, &error);
- }
- }
- if (partials == NULL) /* here if null, something went wrong in the translation functions */
- Xen_error(NO_DATA,
- Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
- C_string_to_Xen_string(S_make_polywave),
- keys[1]));
-
- xcoeffs = partials;
- n = npartials;
- orig_x = xen_make_vct(n, xcoeffs);
- /* xcoeffs = partials here, so don't delete */
- }
-
- if (!(Xen_is_keyword(keys[3])))
- {
- Xen_check_type(mus_is_vct(keys[3]), keys[3], orig_arg[3], S_make_polywave, "a " S_vct);
- orig_x = keys[3];
- v = Xen_to_vct(orig_x);
- n = mus_vct_length(v);
- xcoeffs = mus_vct_data(v);
- }
-
- if (!(Xen_is_keyword(keys[4])))
- {
- /* make-polyoid in generators.scm */
- int yn;
- Xen_check_type(mus_is_vct(keys[4]), keys[4], orig_arg[4], S_make_polywave, "a " S_vct);
- orig_y = keys[4];
- v = Xen_to_vct(orig_y);
- yn = mus_vct_length(v);
- if ((n == 0) || (yn < n))
- n = yn;
- ycoeffs = mus_vct_data(v);
- }
- }
-
- if (!xcoeffs)
- {
- /* clm.html says '(1 1) is the default but table-lookup is 0? */
- mus_float_t *data;
- data = (mus_float_t *)malloc(2 * sizeof(mus_float_t));
- data[0] = 0.0;
- data[1] = 1.0;
- xcoeffs = data;
- n = 2;
- orig_x = xen_make_vct(n, xcoeffs);
- }
-
- if (ycoeffs)
- {
- ge = mus_make_polywave_tu(freq, xcoeffs, ycoeffs, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, orig_x, orig_y)));
- }
- ge = mus_make_polywave(freq, xcoeffs, n, kind);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_x)));
- return(Xen_false);
- }
-
-
- /* ---------------- nrxysin and nrxycos ---------------- */
-
- static Xen g_is_nrxysin(Xen obj)
- {
- #define H_is_nrxysin "(" S_is_nrxysin " gen): " PROC_TRUE " if gen is an " S_nrxysin " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_nrxysin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_nrxycos(Xen obj)
- {
- #define H_is_nrxycos "(" S_is_nrxycos " gen): " PROC_TRUE " if gen is an " S_nrxycos " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_nrxycos(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_nrxysin(Xen obj, Xen fm)
- {
- #define H_nrxysin "(" S_nrxysin " gen (fm 0.0)): next sample of nrxysin generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_nrxysin, S_nrxysin, "an nrxysin generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_nrxysin, 2);
-
- return(C_double_to_Xen_real(mus_nrxysin(g, fm1)));
- }
-
- static Xen g_nrxycos(Xen obj, Xen fm)
- {
- #define H_nrxycos "(" S_nrxycos " gen (fm 0.0)): next sample of nrxycos generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_nrxycos, S_nrxycos, "an nrxycos generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_nrxycos, 2);
-
- return(C_double_to_Xen_real(mus_nrxycos(g, fm1)));
- }
-
-
- static Xen g_make_nrxy(bool sin_case, const char *caller, Xen arglist)
- {
- mus_any *ge;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- int vals;
- mus_float_t freq, r = 0.5, ratio = 1.0;
- int n = 1;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_ratio;
- keys[2] = kw_n;
- keys[3] = kw_r;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 8) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 8; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, 4, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- ratio = Xen_optkey_to_float(kw_ratio, keys[1], caller, orig_arg[1], ratio);
-
- n = Xen_optkey_to_int(kw_n, keys[2], caller, orig_arg[2], n);
- if (n < 0)
- Xen_out_of_range_error(caller, orig_arg[2], keys[2], "n (sidebands) < 0?");
-
- r = Xen_optkey_to_float(kw_r, keys[3], caller, orig_arg[3], r);
- if ((r >= 1.0) ||
- (r <= -1.0))
- Xen_out_of_range_error(caller, orig_arg[3], keys[3], "r (sideband amp ratio) not within -1.0 to 1.0?");
- /* if not with doubles, this actually maxes out around .99999999 because mus_optkey_to_float (apparently) rounds up */
- }
- if (sin_case)
- ge = mus_make_nrxysin(freq, ratio, n, r);
- else ge = mus_make_nrxycos(freq, ratio, n, r);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_make_nrxysin(Xen arglist)
- {
- #define H_make_nrxysin "(" S_make_nrxysin " (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r 0.5)): \
- return a new nrxysin generator."
-
- return(g_make_nrxy(true, S_make_nrxysin, arglist));
- }
-
- static Xen g_make_nrxycos(Xen arglist)
- {
- #define H_make_nrxycos "(" S_make_nrxycos " (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r 0.5)): \
- return a new nrxycos generator."
-
- return(g_make_nrxy(false, S_make_nrxycos, arglist));
- }
-
-
-
- /* ---------------- rxyksin and rxykcos ---------------- */
-
- static Xen g_is_rxyksin(Xen obj)
- {
- #define H_is_rxyksin "(" S_is_rxyksin " gen): " PROC_TRUE " if gen is an " S_rxyksin " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_rxyksin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_rxykcos(Xen obj)
- {
- #define H_is_rxykcos "(" S_is_rxykcos " gen): " PROC_TRUE " if gen is an " S_rxykcos " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_rxykcos(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_rxyksin(Xen obj, Xen fm)
- {
- #define H_rxyksin "(" S_rxyksin " gen (fm 0.0)): next sample of rxyksin generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rxyksin, S_rxyksin, "an rxyksin generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rxyksin, 2);
-
- return(C_double_to_Xen_real(mus_rxyksin(g, fm1)));
- }
-
- static Xen g_rxykcos(Xen obj, Xen fm)
- {
- #define H_rxykcos "(" S_rxykcos " gen (fm 0.0)): next sample of rxykcos generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rxykcos, S_rxykcos, "an rxykcos generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rxykcos, 2);
-
- return(C_double_to_Xen_real(mus_rxykcos(g, fm1)));
- }
-
-
- static Xen g_make_rxyk(bool sin_case, const char *caller, Xen arglist)
- {
- mus_any *ge;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- mus_float_t freq, r = 0.5, ratio = 1.0; /* original in generators.scm assumes initial-phase = 0.0 */
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_ratio;
- keys[2] = kw_r;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 6) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 6; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- ratio = Xen_optkey_to_float(kw_ratio, keys[1], caller, orig_arg[1], ratio);
- r = Xen_optkey_to_float(kw_r, keys[2], caller, orig_arg[2], r);
- }
- if (sin_case)
- ge = mus_make_rxyksin(freq, 0.0, r, ratio);
- else ge = mus_make_rxykcos(freq, 0.0, r, ratio);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_make_rxyksin(Xen arglist)
- {
- #define H_make_rxyksin "(" S_make_rxyksin " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
- return a new rxyksin generator."
-
- return(g_make_rxyk(true, S_make_rxyksin, arglist));
- }
-
- static Xen g_make_rxykcos(Xen arglist)
- {
- #define H_make_rxykcos "(" S_make_rxykcos " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
- return a new rxykcos generator."
-
- return(g_make_rxyk(false, S_make_rxykcos, arglist));
- }
-
-
-
- /* ---------------- filter ---------------- */
-
- typedef enum {G_FILTER, G_FIR_FILTER, G_IIR_FILTER} xclm_fir_t;
-
- static Xen g_make_fir_coeffs(Xen order, Xen envl)
- {
- #define H_make_fir_coeffs "(" S_make_fir_coeffs " order v): turn spectral envelope in " S_vct " v into coeffs for FIR filter"
- int size;
- mus_float_t *a;
- vct *v;
-
- Xen_check_type(Xen_is_integer(order), order, 1, S_make_fir_coeffs, "int");
- Xen_check_type(mus_is_vct(envl), envl, 2, S_make_fir_coeffs, "a " S_vct);
-
- v = Xen_to_vct(envl);
-
- size = Xen_integer_to_C_int(order);
- if (size != mus_vct_length(v))
- Xen_error(CLM_ERROR,
- Xen_list_3(C_string_to_Xen_string(S_make_fir_coeffs ": order ~A != " S_vct " length ~A"),
- order,
- envl));
-
- a = mus_make_fir_coeffs(Xen_integer_to_C_int(order), mus_vct_data(v), NULL);
- return(xen_make_vct(mus_vct_length(v), a));
- }
-
-
- static Xen g_is_filter(Xen obj)
- {
- #define H_is_filter "(" S_is_filter " gen): " PROC_TRUE " if gen is a " S_filter
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_filter(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_fir_filter(Xen obj)
- {
- #define H_is_fir_filter "(" S_is_fir_filter " gen): " PROC_TRUE " if gen is an " S_fir_filter
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_fir_filter(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_iir_filter(Xen obj)
- {
- #define H_is_iir_filter "(" S_is_iir_filter " gen): " PROC_TRUE " if gen is an " S_iir_filter
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_iir_filter(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_filter(Xen obj, Xen input)
- {
- #define H_filter "(" S_filter " gen (input 0.0)): next sample from filter"
- mus_any *g = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(obj, gn, g, mus_is_filter, S_filter, "a filter");
- Xen_real_to_C_double_if_bound(input, x, S_filter, 2);
-
- return(C_double_to_Xen_real(mus_filter(g, x)));
- }
-
-
- static Xen g_fir_filter(Xen obj, Xen input)
- {
- #define H_fir_filter "(" S_fir_filter " gen (input 0.0)): next sample from FIR filter"
- mus_any *g = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(obj, gn, g, mus_is_fir_filter, S_fir_filter, "an FIR filter");
- Xen_real_to_C_double_if_bound(input, x, S_fir_filter, 2);
-
- return(C_double_to_Xen_real(mus_fir_filter(g, x)));
- }
-
-
- static Xen g_iir_filter(Xen obj, Xen input)
- {
- #define H_iir_filter "(" S_iir_filter " gen (input 0.0)): next sample from IIR filter"
- mus_any *g = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(obj, gn, g, mus_is_iir_filter, S_iir_filter, "an IIR filter");
- Xen_real_to_C_double_if_bound(input, x, S_iir_filter, 2);
-
- return(C_double_to_Xen_real(mus_iir_filter(g, x)));
- }
-
-
- static Xen g_make_filter_1(xclm_fir_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- Xen xwave = Xen_undefined, ywave = Xen_undefined;
- mus_any *fgen = NULL;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- vct *x = NULL, *y = NULL;
- int vals, order = 0;
- const char *caller;
- if (choice == G_FILTER) caller = S_make_filter; else if (choice == G_FIR_FILTER) caller = S_make_fir_filter; else caller = S_make_iir_filter;
-
- keys[0] = kw_order;
- keys[1] = kw_x_coeffs;
- keys[2] = kw_y_coeffs;
- keys[3] = kw_coeffs;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6; args[6] = Xen_undefined; args[7] = Xen_undefined;
-
- vals = mus_optkey_unscramble(caller, 4, keys, args, orig_arg);
- if (vals > 0)
- {
- if (!(Xen_is_keyword(keys[0])))
- {
- order = Xen_optkey_to_int(kw_order, keys[0], caller, orig_arg[0], 0);
- if (order <= 0)
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "order <= 0?");
- }
-
- if (!(Xen_is_keyword(keys[1])))
- {
- Xen_check_type(mus_is_vct(keys[1]), keys[1], orig_arg[1], caller, "a " S_vct);
- if (choice == G_IIR_FILTER)
- {
- ywave = keys[1];
- y = Xen_to_vct(ywave);
- }
- else
- {
- xwave = keys[1];
- x = Xen_to_vct(xwave);
- }
- }
-
- if (!(Xen_is_keyword(keys[2])))
- {
- Xen_check_type(mus_is_vct(keys[2]), keys[2], orig_arg[2], caller, "a " S_vct);
- ywave = keys[2];
- y = Xen_to_vct(ywave);
- }
-
- if ((choice != G_FILTER) && (!(Xen_is_keyword(keys[3]))))
- {
- if (choice == G_IIR_FILTER)
- clm_error(caller, "redundant arg passed to " S_make_iir_filter "?", keys[3]);
- else clm_error(caller, "redundant arg passed to " S_make_fir_filter "?", keys[3]);
- }
- }
-
- if (choice == G_FILTER)
- {
- if (y == NULL)
- choice = G_FIR_FILTER;
- else
- {
- if (x == NULL)
- choice = G_IIR_FILTER;
- }
- }
- if (((x == NULL) && (choice != G_IIR_FILTER)) ||
- ((y == NULL) && (choice != G_FIR_FILTER)))
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: no coeffs?"),
- C_string_to_Xen_string(caller)));
- if (order == 0)
- {
- if (x)
- order = mus_vct_length(x);
- else order = mus_vct_length(y);
- }
- else
- {
- if ((x) && (order > mus_vct_length(x)))
- {
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: xcoeffs, ~A, must match order, ~A"),
- C_string_to_Xen_string(caller),
- keys[1],
- keys[0]));
- }
- else
- {
- if ((y) && (order > mus_vct_length(y)))
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: ycoeffs, ~A, must match order, ~A"),
- C_string_to_Xen_string(caller),
- keys[2],
- keys[0]));
- else
- {
- if ((x) && (y) && (mus_vct_length(x) != mus_vct_length(y)))
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: coeffs must be same length. x len: ~A, y len: ~A"),
- C_string_to_Xen_string(caller),
- C_int_to_Xen_integer(mus_vct_length(x)),
- C_int_to_Xen_integer(mus_vct_length(y))));
- }
- }
- }
- switch (choice)
- {
- case G_FILTER: fgen = mus_make_filter(order, mus_vct_data(x), mus_vct_data(y), NULL); break;
- case G_FIR_FILTER: fgen = mus_make_fir_filter(order, mus_vct_data(x), NULL); break;
- case G_IIR_FILTER: fgen = mus_make_iir_filter(order, mus_vct_data(y), NULL); break;
- }
- if (fgen)
- {
- mus_xen *gn = NULL;
- gn = mx_alloc(3);
- gn->gen = fgen; /* delay gn allocation since make_filter can throw an error */
- gn->vcts[G_FILTER_STATE] = xen_make_vct_wrapper(order, mus_data(fgen));
- gn->vcts[G_FILTER_XCOEFFS] = xwave;
- gn->vcts[G_FILTER_YCOEFFS] = ywave;
- return(mus_xen_to_object(gn));
- }
- return(Xen_false);
- }
-
-
- static Xen g_make_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_filter "(" S_make_filter " order xcoeffs ycoeffs): return a new direct form FIR/IIR filter, coeff args are " S_vct "s"
- return(g_make_filter_1(G_FILTER, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_fir_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_fir_filter "(" S_make_fir_filter " order xcoeffs): return a new FIR filter, xcoeffs a " S_vct
- return(g_make_filter_1(G_FIR_FILTER, arg1, arg2, arg3, arg4, Xen_undefined, Xen_undefined));
- }
-
-
- static Xen g_make_iir_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_iir_filter "(" S_make_iir_filter " order ycoeffs): return a new IIR filter, ycoeffs a " S_vct
- return(g_make_filter_1(G_IIR_FILTER, arg1, arg2, arg3, arg4, Xen_undefined, Xen_undefined));
- }
-
-
-
-
- /* ---------------- env ---------------- */
-
- static Xen g_is_env(Xen obj)
- {
- #define H_is_env "(" S_is_env " gen): " PROC_TRUE " if gen is a " S_env
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_env(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_env(Xen obj)
- {
- #define H_env "(" S_env " gen): next sample from envelope generator"
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_env, S_env, "an env generator");
-
- return(C_double_to_Xen_real(mus_env(g)));
- }
-
-
- static Xen g_make_env(Xen arglist)
- {
- #define H_make_env "(" S_make_env " envelope (scaler 1.0) (duration) (offset 0.0) (base 1.0) (end) (length)): \
- return a new envelope generator. 'envelope' is a list, vector, or " S_vct " of break-point pairs. To create the envelope, \
- these points are offset by 'offset', scaled by 'scaler', and mapped over the time interval defined by \
- either 'duration' (seconds) or 'length' (samples). If 'base' is 1.0, the connecting segments \
- are linear, if 0.0 you get a step function, and anything else produces an exponential connecting segment."
-
- mus_any *ge;
- Xen args[14];
- Xen keys[7];
- int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
- int vals, i;
- mus_float_t base = 1.0, scaler = 1.0, offset = 0.0, duration = 0.0;
- mus_long_t end = 0, dur = -1;
- int npts = 0;
- mus_float_t *brkpts = NULL;
- vct *v = NULL;
-
- keys[0] = kw_envelope;
- keys[1] = kw_scaler;
- keys[2] = kw_duration;
- keys[3] = kw_offset;
- keys[4] = kw_base;
- keys[5] = kw_end;
- keys[6] = kw_length;
-
- {
- int arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 14) clm_error(S_make_env, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 14; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_env, 7, keys, args, orig_arg);
- if (vals > 0)
- {
- scaler = Xen_optkey_to_float(kw_scaler, keys[1], S_make_env, orig_arg[1], 1.0);
-
- duration = Xen_optkey_to_float(kw_duration, keys[2], S_make_env, orig_arg[2], 0.0);
- if ((duration < 0.0) || ((duration == 0.0) && (!Xen_is_keyword(keys[2]))))
- Xen_out_of_range_error(S_make_env, orig_arg[2], keys[2], "duration <= 0.0?");
-
- offset = Xen_optkey_to_float(kw_offset, keys[3], S_make_env, orig_arg[3], 0.0);
-
- base = Xen_optkey_to_float(kw_base, keys[4], S_make_env, orig_arg[4], 1.0);
- if (base < 0.0)
- Xen_out_of_range_error(S_make_env, orig_arg[4], keys[4], "base < 0.0?");
-
- end = Xen_optkey_to_mus_long_t(kw_end, keys[5], S_make_env, orig_arg[5], 0);
- if (end < 0)
- Xen_out_of_range_error(S_make_env, orig_arg[5], keys[5], "end < 0?");
-
- dur = Xen_optkey_to_mus_long_t(kw_length, keys[6], S_make_env, orig_arg[6], 0);
- if (dur < 0)
- Xen_out_of_range_error(S_make_env, orig_arg[6], keys[6], "length < 0?");
-
- /* env data is a list, checked last to let the preceding throw wrong-type error before calloc */
- if (!(Xen_is_keyword(keys[0])))
- {
- int len;
- Xen vect = XEN_NULL;
- if (mus_is_vct(keys[0]))
- {
- v = Xen_to_vct(keys[0]);
- len = mus_vct_length(v);
- if ((len < 2) || (len & 1))
- Xen_error(BAD_TYPE,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": " S_vct " is a bogus breakpoints list, ~A"),
- keys[0]));
- }
- else
- {
- #if HAVE_SCHEME
- /* in Ruby and Forth vectors and lists are the same, so stay with the old code */
- if (Xen_is_vector(keys[0]))
- {
- vect = keys[0];
- len = Xen_vector_length(vect);
- if ((len < 2) || (len & 1))
- Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_make_env ": vector is a bogus breakpoints list, ~A"), vect));
- }
- else
- {
- #endif
- Xen_check_type(Xen_is_list(keys[0]), keys[0], orig_arg[0], S_make_env, "a list, vector, or " S_vct);
- len = Xen_list_length(keys[0]);
- if (len == 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": null env? ~A"),
- keys[0]));
-
- if (Xen_is_list(Xen_car(keys[0])))
- len *= 2;
- else
- {
- if (len & 1)
- Xen_error(BAD_TYPE,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": odd length breakpoints list? ~A"),
- keys[0]));
-
- if (!(Xen_is_number(Xen_car(keys[0]))))
- Xen_check_type(false, keys[0], orig_arg[0], S_make_env, "a list of numbers (breakpoints)");
- }
- }
- #if HAVE_SCHEME
- }
- #endif
- npts = len / 2;
- if (v)
- brkpts = mus_vct_data(v);
- else
- {
- brkpts = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- if (brkpts == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate env list", S_make_env));
- if (vect)
- {
- for (i = 0; i < len; i++)
- brkpts[i] = Xen_real_to_C_double(Xen_vector_ref(vect, i));
- }
- else
- {
- Xen lst;
- if (Xen_is_number(Xen_car(keys[0])))
- {
- for (i = 0, lst = Xen_copy_arg(keys[0]); (i < len) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
- brkpts[i] = Xen_real_to_C_double(Xen_car(lst));
- }
- else
- {
- for (i = 0, lst = Xen_copy_arg(keys[0]); (i < len) && (!Xen_is_null(lst)); i += 2, lst = Xen_cdr(lst))
- {
- Xen el;
- el = Xen_car(lst);
- if ((Xen_is_pair(el)) &&
- (Xen_is_number(Xen_car(el))) &&
- (Xen_is_pair(Xen_cdr(el))) &&
- (Xen_is_number(Xen_cadr(el))))
- {
- brkpts[i] = Xen_real_to_C_double(Xen_car(el));
- brkpts[i + 1] = Xen_real_to_C_double(Xen_cadr(el));
- }
- else
- {
- Xen_error(BAD_TYPE,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": odd breakpoints list? ~A"),
- keys[0]));
- }
- }
- }
- }
- }
- }
- }
-
- if (brkpts == NULL)
- {
- Xen_error(NO_DATA,
- Xen_list_1(C_string_to_Xen_string(S_make_env ": no envelope?")));
- }
-
- if (dur > 0)
- {
- if ((end > 0) && ((end + 1) != dur))
- {
- if ((!v) && (brkpts)) {free(brkpts); brkpts = NULL;}
- Xen_error(CLM_ERROR,
- Xen_list_3(C_string_to_Xen_string(S_make_env ": end, ~A, and dur, ~A, specified, but dur != end+1"),
- keys[5],
- keys[6]));
- }
- end = dur - 1;
- }
-
- /* (make-env '(0 1 1 0) :duration most-positive-fixnum) -> env linear, pass: 0 (dur: -9223372036854775808)...
- */
- if ((end <= 0) && (duration <= 0.0))
- Xen_out_of_range_error(S_make_env, 0, C_double_to_Xen_real(duration), "duration <= 0.0?");
- if (duration > (24 * 3600 * 365))
- Xen_out_of_range_error(S_make_env, 0, C_double_to_Xen_real(duration), "duration > year?");
-
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_env(brkpts, npts, scaler, offset, base, duration, end, NULL);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- if (v)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, keys[0]))); /* in s7, keys[0] == v */
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, xen_make_vct(mus_env_breakpoints(ge) * 2, brkpts))));
- }
- return(clm_mus_error(local_error_type, local_error_msg, S_make_env));
- }
-
-
- static Xen g_env_interp(Xen x, Xen env1) /* "env" causes trouble in Objective-C!! */
- {
- #define H_env_interp "(" S_env_interp " x env): value of envelope env at x"
- Xen_check_type(Xen_is_number(x), x, 1, S_env_interp, "a number");
- Xen_check_type((mus_is_xen(env1)) && (mus_is_env(Xen_to_mus_any(env1))), env1, 2, S_env_interp, "an env generator");
- return(C_double_to_Xen_real(mus_env_interp(Xen_real_to_C_double(x), Xen_to_mus_any(env1))));
- }
-
-
-
- /* mus_env_any calls the C function itself, so we pass it connect_func,
- * connect_func uses the function passed as an argument to g_env_any.
- * I can't think of a cleaner way to handle this except via nested functions.
- * Both versions seem to work ok with recursive env-any calls.
- */
-
- static Xen current_connect_func;
-
- static mus_float_t connect_func(mus_float_t val)
- {
- return(Xen_real_to_C_double(Xen_call_with_1_arg(current_connect_func,
- C_double_to_Xen_real(val),
- S_env_any " connect function")));
- }
-
- static Xen g_env_any(Xen e, Xen func)
- {
- Xen val;
- Xen old_connect_func = Xen_false;
-
- #define H_env_any "(" S_env_any " e func) uses 'func' to connect the dots in the env 'e'"
- Xen_check_type((mus_is_xen(e)) && (mus_is_env(Xen_to_mus_any(e))), e, 1, S_env_any, "an env generator");
- Xen_check_type((Xen_is_procedure(func)) && (Xen_is_aritable(func, 1)), func, 2, S_env_any, "a function of one arg");
-
- old_connect_func = current_connect_func;
- current_connect_func = func;
- val = C_double_to_Xen_real(mus_env_any(Xen_to_mus_any(e), connect_func));
- current_connect_func = old_connect_func;
-
- return(val);
- }
-
-
-
- #define S_envelope_interp "envelope-interp"
-
- static Xen g_envelope_interp(Xen ux, Xen e, Xen ubase)
- {
- #define H_envelope_interp "(envelope-interp x e (base 1.0)) -> value of e at x; base controls connecting segment type: (envelope-interp .3 '(0 0 .5 1 1 0)) -> .6"
- mus_float_t x, base = 1.0, x0, y0, y1;
- Xen_check_type(Xen_is_number(ux), ux, 1, S_envelope_interp, "a number");
- Xen_check_type(Xen_is_list(e), e, 2, S_envelope_interp, "a list");
-
- if (Xen_is_null(e))
- return(Xen_integer_zero);
-
- x = Xen_real_to_C_double(ux);
- if (Xen_is_bound(ubase)) base = Xen_real_to_C_double(ubase);
- x0 = Xen_real_to_C_double(Xen_car(e));
-
- while (true)
- {
- mus_float_t x1;
- Xen ey;
- if (!Xen_is_pair(Xen_cdr(e)))
- Xen_check_type(false, e, 2, S_envelope_interp, "a list of breakpoint values");
- ey = Xen_cadr(e);
- if ((x <= x0) ||
- (!Xen_is_pair(Xen_cddr(e))))
- return(ey);
- x1 = Xen_real_to_C_double(Xen_caddr(e));
- if (x < x1)
- {
- if (base == 0.0)
- return(ey);
- y0 = Xen_real_to_C_double(ey);
- y1 = Xen_real_to_C_double(Xen_cadddr(e));
- if (y0 == y1)
- return(ey);
- if (base == 1.0)
- return(C_double_to_Xen_real(y0 + ((x - x0) * (y1 - y0) / (x1 - x0))));
- return(C_double_to_Xen_real(y0 + (((y1 - y0) / (base - 1.0)) * (pow(base, (x - x0) / (x1 - x0)) - 1.0))));
- }
- e = Xen_cddr(e);
- x0 = x1;
- }
- return(Xen_false);
- }
-
- /* -------------------------------- pulsed-env -------------------------------- */
-
- static Xen g_make_pulsed_env(Xen e, Xen dur, Xen frq)
- {
- #define H_make_pulsed_env "(" S_make_pulsed_env " envelope duration frequency) returns a pulsed-env generator."
- Xen gp, ge;
- mus_any *pl;
-
- gp = g_make_pulse_train(frq, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined);
- ge = g_make_env(Xen_list_3(e, C_double_to_Xen_real(1.0), dur));
-
- pl = mus_make_pulsed_env(Xen_to_mus_any(ge), Xen_to_mus_any(gp));
- return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(pl, ge, gp)));
- }
-
- static Xen g_is_pulsed_env(Xen os)
- {
- #define H_is_pulsed_env "(" S_is_pulsed_env " gen) returns " PROC_TRUE " if gen is a pulsed-env generator."
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_pulsed_env(Xen_to_mus_any(os)))));
- }
-
- static Xen g_pulsed_env(Xen g, Xen fm)
- {
- #define H_pulsed_env "(" S_pulsed_env " gen fm) runs a pulsed-env generator."
- mus_any *pl = NULL;
-
- Xen_check_type((mus_is_xen(g)) && (mus_is_pulsed_env(pl = Xen_to_mus_any(g))), g, 1, S_pulsed_env, "a pulsed-env object");
-
- if (Xen_is_number(fm))
- return(C_double_to_Xen_real(mus_pulsed_env(pl, Xen_real_to_C_double(fm))));
- return(C_double_to_Xen_real(mus_pulsed_env_unmodulated(pl)));
- }
-
-
-
-
- /* ---------------- io ---------------- */
-
- #if (!HAVE_RUBY)
- #define S_output "*output*"
- #define S_reverb "*reverb*"
- #else
- #define S_output "output"
- #define S_reverb "reverb"
- #endif
-
- static Xen clm_output, clm_reverb; /* *output* and *reverb* at extlang level -- these can be output streams, vct, sound-data objects etc */
-
- #if (HAVE_SCHEME)
- static Xen clm_output_slot = NULL, clm_reverb_slot = NULL;
-
- #define CLM_OUTPUT s7_slot_value(clm_output_slot)
- #define CLM_REVERB s7_slot_value(clm_reverb_slot)
-
- #else
-
- #define CLM_OUTPUT Xen_variable_ref(S_output)
- #define CLM_REVERB Xen_variable_ref(S_reverb)
-
- #endif
-
-
- static Xen g_is_mus_input(Xen obj)
- {
- #define H_is_mus_input "(" S_is_mus_input " gen): " PROC_TRUE " if gen is an input generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_input(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_mus_output(Xen obj)
- {
- #define H_is_mus_output "(" S_is_mus_output " gen): " PROC_TRUE " if gen is an output generator"
-
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_output(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_file_to_sample(Xen obj)
- {
- #define H_is_file_to_sample "(" S_is_file_to_sample " gen): " PROC_TRUE " if gen is a " S_file_to_sample " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_file_to_sample(Xen_to_mus_any(obj)))));
- }
-
- static Xen mus_clm_output(void) {return(CLM_OUTPUT);}
- static Xen mus_clm_reverb(void) {return(CLM_REVERB);}
-
- static Xen g_is_file_to_frample(Xen obj)
- {
- #define H_is_file_to_frample "(" S_is_file_to_frample " gen): " PROC_TRUE " if gen is a " S_file_to_frample " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_file_to_frample(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_sample_to_file(Xen obj)
- {
- #define H_is_sample_to_file "(" S_is_sample_to_file " gen): " PROC_TRUE " if gen is a " S_sample_to_file " generator"
-
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_sample_to_file(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_frample_to_file(Xen obj)
- {
- #define H_is_frample_to_file "(" S_is_frample_to_file " gen): " PROC_TRUE " if gen is a " S_frample_to_file " generator"
-
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_frample_to_file(Xen_to_mus_any(obj)))));
- }
-
-
- #if HAVE_SCHEME
- static mus_float_t (*in_any_2)(mus_long_t pos, int chn);
- #endif
-
- static Xen g_in_any_1(const char *caller, Xen frample, int in_chan, Xen inp)
- {
- mus_long_t pos;
-
- Xen_check_type(Xen_is_integer(frample), frample, 1, caller, "an integer");
-
- pos = Xen_llong_to_C_llong(frample);
- if (pos < 0)
- Xen_out_of_range_error(caller, 1, frample, "location should be >= 0");
-
- if (in_chan < 0)
- Xen_out_of_range_error(caller, 2, C_int_to_Xen_integer(in_chan), "must be >= 0");
-
- #if HAVE_SCHEME
- if (Xen_is_false(inp)) return(C_double_to_Xen_real(0.0)); /* ws.scm default for *clm-reverb* is #f */
- if (inp == CLM_REVERB)
- return(s7_make_real(s7, in_any_2(pos, in_chan)));
- #endif
-
- if (mus_is_xen(inp))
- {
- Xen_check_type(mus_is_input(Xen_to_mus_any(inp)), inp, 3, caller, "an input generator");
- return(C_double_to_Xen_real(mus_in_any(pos, in_chan, (mus_any *)Xen_to_mus_any(inp))));
- }
-
- if (mus_is_vct(inp))
- {
- #if HAVE_SCHEME
- if (pos < s7_vector_length(inp))
- {
- if (s7_vector_rank(inp) > 1)
- return(s7_vector_ref_n(s7, inp, 2, in_chan, pos));
- return(s7_vector_ref(s7, inp, pos));
- }
- return(C_double_to_Xen_real(0.0));
- #else
- vct *v;
- mus_float_t *vdata;
- v = Xen_to_vct(inp);
- vdata = mus_vct_data(v);
- if (pos < mus_vct_length(v))
- return(C_double_to_Xen_real(vdata[pos]));
- return(C_double_to_Xen_real(0.0));
- #endif
- }
-
- if (Xen_is_vector(inp))
- {
- if (pos < Xen_vector_length(inp))
- return(Xen_vector_ref(inp, pos));
- }
-
- return(C_double_to_Xen_real(0.0));
- }
-
-
- static Xen g_in_any(Xen frample, Xen chan, Xen inp)
- {
- #define H_in_any "(" S_in_any " frample chan stream): input stream sample at frample in channel chan"
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_in_any, "an integer");
- return(g_in_any_1(S_in_any, frample, Xen_integer_to_C_int(chan), inp));
- }
-
-
- static Xen g_ina(Xen frample, Xen inp)
- {
- #define H_ina "(" S_ina " frample stream): input stream sample in channel 0 at frample"
- return(g_in_any_1(S_ina, frample, 0, inp));
- }
-
-
- static Xen g_inb(Xen frample, Xen inp)
- {
- #define H_inb "(" S_inb " frample stream): input stream sample in channel 1 at frample"
- return(g_in_any_1(S_inb, frample, 1, inp));
- }
-
-
- #if (!HAVE_SCHEME)
- static Xen out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- #else
- static Xen fallback_out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- #endif
- {
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(outp, mus_xen_tag);
- if (gn)
- {
- /* mus_out_any will check the writer so output_p is pointless */
- mus_out_any(pos, inv, chn, mus_xen_to_mus_any(gn));
- return(Xen_integer_zero);
- }
-
- if (mus_is_vct(outp))
- {
- mus_float_t *vdata;
- vct *v;
- v = xen_to_vct(outp);
- vdata = mus_vct_data(v);
- if (Xen_vector_rank(outp) == 1)
- {
- if (chn == 0)
- {
- if (pos < mus_vct_length(v))
- vdata[pos] += inv;
- }
- }
- #if HAVE_SCHEME
- else
- {
- s7_int *offsets;
- offsets = s7_vector_offsets(outp);
- pos += (chn * offsets[0]);
- if (pos < mus_vct_length(v))
- vdata[pos] += inv;
- }
- #endif
- return(Xen_integer_zero);
- }
-
- if (Xen_is_vector(outp))
- {
- if (pos < Xen_vector_length(outp))
- Xen_vector_set(outp, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(outp, pos)) + inv));
- }
-
- return(Xen_integer_zero);
- }
-
- #if HAVE_SCHEME
-
- static Xen (*out_any_2)(mus_long_t pos, mus_float_t inv, int chn, const char *caller);
-
- bool mus_simple_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO);
- bool mus_simple_outa_to_file(mus_long_t samp, mus_float_t val, mus_any *IO);
-
- static mus_xen *clm_output_gn = NULL;
- static mus_any *clm_output_gen = NULL;
- static vct *clm_output_vct;
-
- static Xen out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- mus_out_any(pos, inv, chn, clm_output_gen);
- return(xen_zero);
- }
-
- static Xen safe_out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- if (!mus_simple_out_any_to_file(pos, inv, chn, clm_output_gen))
- mus_safe_out_any_to_file(pos, inv, chn, clm_output_gen);
- return(xen_zero);
- }
-
-
- static Xen out_any_2_to_vct(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- mus_float_t *vdata;
- vdata = mus_vct_data(clm_output_vct);
-
- #if (!HAVE_SCHEME)
- if ((chn == 0) &&
- (pos < mus_vct_length(clm_output_vct)))
- vdata[pos] += inv;
- #else
- if (Xen_vector_rank(clm_output_vct) == 1)
- {
- if ((chn == 0) &&
- (pos < mus_vct_length(clm_output_vct)))
- vdata[pos] += inv;
- }
- else
- {
- s7_int chans;
- chans = s7_vector_dimensions(clm_output_vct)[0];
- if (chn < chans)
- {
- s7_int chan_len;
- chan_len = s7_vector_dimensions(clm_output_vct)[1];
- if (pos < chan_len)
- vdata[chn * chan_len + pos] += inv;
- }
- }
- #endif
- return(xen_zero);
- }
-
-
- static Xen out_any_2_to_vector(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- if (pos < Xen_vector_length(CLM_OUTPUT))
- Xen_vector_set(CLM_OUTPUT, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(CLM_OUTPUT, pos)) + inv));
- return(xen_zero);
- }
-
- static Xen out_any_2_no_op(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- return(xen_zero);
- }
-
- static s7_pointer g_clm_output_set(s7_scheme *sc, s7_pointer args)
- {
- s7_pointer new_output;
- new_output = s7_cadr(args);
-
- clm_output_gn = (mus_xen *)Xen_object_ref_checked(new_output, mus_xen_tag);
- if (clm_output_gn)
- {
- out_any_2 = out_any_2_to_mus_xen;
- clm_output_gen = clm_output_gn->gen;
-
- if (mus_out_any_is_safe(clm_output_gen))
- out_any_2 = safe_out_any_2_to_mus_xen;
- }
- else
- {
- clm_output_gen = NULL;
- if (mus_is_vct(new_output))
- {
- out_any_2 = out_any_2_to_vct;
- clm_output_vct = xen_to_vct(new_output);
- }
- else
- {
- if (Xen_is_vector(new_output))
- {
- out_any_2 = out_any_2_to_vector;
- }
- else out_any_2 = out_any_2_no_op;
- }
- }
- return(new_output);
- }
-
-
- /* need in_any_2(pos, 0, caller) -> double + safe case + none-file cases
- */
-
- static mus_xen *clm_input_gn;
- static mus_any *clm_input_gen;
- static vct *clm_input_vct;
-
- static mus_float_t in_any_2_to_mus_xen(mus_long_t pos, int chn)
- {
- return(mus_in_any(pos, chn, clm_input_gen));
- }
-
- static mus_float_t safe_in_any_2_to_mus_xen(mus_long_t pos, int chn)
- {
- return(mus_file_to_sample(clm_input_gen, pos, chn));
- }
-
- static mus_float_t in_any_2_to_vct(mus_long_t pos, int chn)
- {
- mus_float_t *vdata;
- vdata = mus_vct_data(clm_input_vct);
- if ((chn == 0) &&
- (pos < mus_vct_length(clm_input_vct)))
- return(vdata[pos]);
- return(0.0);
- }
-
- static mus_float_t in_any_2_to_vector(mus_long_t pos, int chn)
- {
- if (pos < Xen_vector_length(CLM_REVERB))
- return(Xen_real_to_C_double(Xen_vector_ref(CLM_REVERB, pos)));
- return(0.0);
- }
-
- static mus_float_t in_any_2_no_op(mus_long_t pos, int chn)
- {
- return(0.0);
- }
-
- static s7_pointer g_clm_reverb_set(s7_scheme *sc, s7_pointer args)
- {
- s7_pointer new_input;
- new_input = s7_cadr(args);
-
- clm_input_gn = (mus_xen *)Xen_object_ref_checked(new_input, mus_xen_tag);
- if (clm_input_gn)
- {
- in_any_2 = in_any_2_to_mus_xen;
- clm_input_gen = clm_input_gn->gen;
-
- if (mus_in_any_is_safe(clm_input_gen))
- in_any_2 = safe_in_any_2_to_mus_xen;
- }
- else
- {
- if (mus_is_vct(new_input))
- {
- in_any_2 = in_any_2_to_vct;
- clm_input_vct = xen_to_vct(new_input);
- }
- else
- {
- if (Xen_is_vector(new_input))
- {
- in_any_2 = in_any_2_to_vector;
- }
- else in_any_2 = in_any_2_no_op;
- }
- }
- return(new_input);
- }
-
-
- #endif
-
-
- #define S_out_bank "out-bank"
- static Xen g_out_bank(Xen gens, Xen loc, Xen inval)
- {
- #define H_out_bank "(out-bank gens location val) calls each generator in the gens vector, passing it the argument val, then \
- sends that output to the output channels in the vector order (the first generator writes to outa, the second to outb, etc)."
-
- mus_long_t pos;
- int i, size;
- mus_float_t x = 0.0;
-
- Xen_check_type(Xen_is_integer(loc), loc, 2, S_out_bank, "an integer");
- pos = Xen_llong_to_C_llong(loc);
- if (pos < 0)
- Xen_out_of_range_error(S_out_bank, 2, loc, "must be >= 0");
-
- Xen_check_type(Xen_is_vector(gens), gens, 1, S_out_bank, "a vector of generators");
- size = Xen_vector_length(gens);
-
- Xen_check_type(Xen_is_number(inval), inval, 3, S_out_bank, "a number");
- x = Xen_real_to_C_double(inval);
-
- #if HAVE_SCHEME
- for (i = 0; i < size; i++)
- {
- mus_any *g = NULL;
- mus_xen *gn;
- Xen_to_C_any_generator(Xen_vector_ref(gens, i), gn, g, S_out_bank, "an output generator");
- out_any_2(pos, mus_apply(g, x, 0.0), i, S_out_bank);
- }
- #else
- for (i = 0; i < size; i++)
- {
- mus_any *g = NULL;
- mus_xen *gn;
- Xen_to_C_any_generator(Xen_vector_ref(gens, i), gn, g, S_out_bank, "an output generator");
- out_any_2(CLM_OUTPUT, pos, mus_apply(g, x, 0.0), i, S_out_bank);
- }
- #endif
-
- return(inval);
- }
-
-
- static Xen g_out_any_1(const char *caller, Xen frample, int chn, Xen val, Xen outp)
- {
- mus_long_t pos = 0;
- mus_float_t inv;
-
- if (chn < 0)
- Xen_out_of_range_error(caller, 3, C_int_to_Xen_integer(chn), "must be >= 0");
- Xen_to_C_integer_or_error(frample, pos, caller, 1);
- if (pos < 0)
- Xen_out_of_range_error(caller, 1, frample, "must be >= 0");
-
- Xen_to_C_double_or_error(val, inv, caller, 2);
-
- if (!Xen_is_bound(outp))
- #if (!HAVE_SCHEME)
- return(out_any_2(CLM_OUTPUT, pos, inv, chn, caller));
- #else
- return(out_any_2(pos, inv, chn, caller));
- #endif
-
- #if (!HAVE_SCHEME)
- return(out_any_2(outp, pos, inv, chn, caller));
- #else
- if (outp == CLM_OUTPUT)
- return(out_any_2(pos, inv, chn, caller));
- return(fallback_out_any_2(outp, pos, inv, chn, caller));
- #endif
- }
-
- static Xen g_out_any(Xen frample, Xen val, Xen chan, Xen outp)
- {
- #define H_out_any "(" S_out_any " frample val chan stream): add val to output stream at frample in channel chan"
- Xen_check_type(Xen_is_integer(chan), chan, 3, S_out_any, "an integer");
- return(g_out_any_1(S_out_any, frample, Xen_integer_to_C_int(chan), val, outp));
- }
-
-
- static Xen g_outa(Xen frample, Xen val, Xen outp)
- {
- #define H_outa "(" S_outa " frample val stream): add val to output stream at frample in channel 0"
- return(g_out_any_1(S_outa, frample, 0, val, outp));
- }
-
-
- static Xen g_outb(Xen frample, Xen val, Xen outp)
- {
- #define H_outb "(" S_outb " frample val stream): add val to output stream at frample in channel 1"
- return(g_out_any_1(S_outb, frample, 1, val, outp));
- }
-
-
- static Xen g_outc(Xen frample, Xen val, Xen outp)
- {
- #define H_outc "(" S_outc " frample val stream): add val to output stream at frample in channel 2"
- return(g_out_any_1(S_outc, frample, 2, val, outp));
- }
-
-
- static Xen g_outd(Xen frample, Xen val, Xen outp)
- {
- #define H_outd "(" S_outd " frample val stream): add val to output stream at frample in channel 3"
- return(g_out_any_1(S_outd, frample, 3, val, outp));
- }
-
-
- static Xen g_mus_close(Xen ptr)
- {
- #define H_mus_close "(" S_mus_close " gen): close the IO stream managed by 'gen' (a sample->file generator, for example)"
-
- if (mus_is_xen(ptr))
- return(C_int_to_Xen_integer(mus_close_file((mus_any *)Xen_to_mus_any(ptr))));
-
- Xen_check_type(mus_is_vct(ptr) || Xen_is_false(ptr) || Xen_is_vector(ptr),
- ptr, 1, S_mus_close, "an IO gen or its outa equivalent");
- return(Xen_integer_zero);
- }
-
-
- static Xen g_make_file_to_sample(Xen name, Xen buffer_size)
- {
- #define H_make_file_to_sample "(" S_make_file_to_sample " filename buffer-size): return an input generator reading 'filename' (a sound file)"
-
- mus_any *ge;
- mus_long_t size;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_file_to_sample, "a string");
- Xen_check_type(Xen_is_llong_or_unbound(buffer_size), buffer_size, 2, S_make_file_to_sample, "an integer");
-
- if (!(mus_file_probe(Xen_string_to_C_string(name))))
- Xen_error(NO_SUCH_FILE,
- Xen_list_3(C_string_to_Xen_string(S_make_file_to_sample ": ~S, ~A"),
- name,
- C_string_to_Xen_string(STRERROR(errno))));
-
- if (Xen_is_llong(buffer_size))
- {
- size = Xen_llong_to_C_llong(buffer_size);
- if (size <= 0)
- Xen_out_of_range_error(S_make_file_to_sample, 2, buffer_size, "must be > 0");
- }
- else size = mus_file_buffer_size();
-
- ge = mus_make_file_to_sample_with_buffer_size(Xen_string_to_C_string(name), size);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_file_to_sample(Xen obj, Xen samp, Xen chan)
- {
- #define H_file_to_sample "(" S_file_to_sample " obj frample chan): sample value in sound file read by 'obj' in channel chan at frample"
- int channel = 0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_input, S_file_to_sample, "an input generator");
- Xen_check_type(Xen_is_llong(samp), samp, 2, S_file_to_sample, "an integer");
-
- if (Xen_is_bound(chan))
- {
- Xen_check_type(Xen_is_integer(chan), chan, 3, S_file_to_sample, "an integer");
- channel = Xen_integer_to_C_int(chan);
- }
- return(C_double_to_Xen_real(mus_file_to_sample(g, Xen_llong_to_C_llong(samp), channel)));
- }
-
-
- static Xen g_make_sample_to_file(Xen name, Xen chans, Xen out_format, Xen out_type, Xen comment)
- {
- #if HAVE_SCHEME
- #define make_sample_to_file_example "(" S_make_sample_to_file " \"test.snd\" 2 mus-lshort mus-riff)"
- #endif
- #if HAVE_RUBY
- #define make_sample_to_file_example "\"test.snd\" 2 Mus_lshort Mus_riff make_sample2file"
- #endif
- #if HAVE_FORTH
- #define make_sample_to_file_example "\"test.snd\" 2 mus-lshort mus-riff make-sample->file"
- #endif
-
- #define H_make_sample_to_file "(" S_make_sample_to_file " filename chans sample-type header-type comment): \
- return an output generator writing the sound file 'filename' which is set up to have \
- 'chans' channels of 'sample-type' samples with a header of 'header-type'. The latter \
- should be sndlib identifiers:\n " make_sample_to_file_example
-
- mus_sample_t df = MUS_OUT_SAMPLE_TYPE;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_sample_to_file, "a string");
- Xen_check_type(Xen_is_integer_or_unbound(chans), chans, 2, S_make_sample_to_file, "an integer");
- Xen_check_type(Xen_is_integer_or_unbound(out_format), out_format, 3, S_make_sample_to_file, "an integer (sample type)");
- Xen_check_type(Xen_is_integer_or_unbound(out_type), out_type, 4, S_make_sample_to_file, "an integer (header type)");
-
- if (Xen_is_integer(out_format)) df = (mus_sample_t)Xen_integer_to_C_int(out_format);
- if (mus_is_sample_type(df))
- {
- mus_header_t ht = MUS_NEXT;
- if (Xen_is_integer(out_type)) ht = (mus_header_t)Xen_integer_to_C_int(out_type);
- if (mus_is_header_type(ht))
- {
- int chns = 1;
- if (Xen_is_integer(chans)) chns = Xen_integer_to_C_int(chans);
- if (chns > 0)
- {
- mus_any *rgen;
- rgen = mus_make_sample_to_file_with_comment(Xen_string_to_C_string(name),
- chns, df, ht,
- (Xen_is_string(comment)) ? Xen_string_to_C_string(comment) : NULL);
- if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- }
- else Xen_out_of_range_error(S_make_sample_to_file, 2, chans, "chans <= 0?");
- }
- else Xen_out_of_range_error(S_make_sample_to_file, 4, out_type, "invalid header type");
- }
- else Xen_out_of_range_error(S_make_sample_to_file, 3, out_format, "invalid sample type");
- return(Xen_false);
- }
-
-
- static Xen g_continue_sample_to_file(Xen name)
- {
- #define H_continue_sample_to_file "(" S_continue_sample_to_file " filename): return an output generator \
- that reopens an existing sound file 'filename' ready for output via " S_sample_to_file
-
- mus_any *rgen = NULL;
- Xen_check_type(Xen_is_string(name), name, 1, S_continue_sample_to_file, "a string");
- rgen = mus_continue_sample_to_file(Xen_string_to_C_string(name));
- if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- return(Xen_false);
- }
-
-
- static Xen g_sample_to_file(Xen obj, Xen samp, Xen chan, Xen val)
- {
- #define H_sample_to_file "(" S_sample_to_file " obj samp chan val): add val to the output stream \
- handled by the output generator 'obj', in channel 'chan' at frample 'samp'"
-
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_any_generator(obj, gn, g, S_sample_to_file, "an output generator");
- Xen_check_type(mus_is_output(g), obj, 1, S_sample_to_file, "an output generator");
-
- Xen_check_type(Xen_is_integer(samp), samp, 2, S_sample_to_file, "an integer");
- Xen_check_type(Xen_is_integer(chan), chan, 3, S_sample_to_file, "an integer");
- Xen_check_type(Xen_is_number(val), val, 4, S_sample_to_file, "a number");
-
- mus_sample_to_file(g,
- Xen_llong_to_C_llong(samp),
- Xen_integer_to_C_int(chan),
- Xen_real_to_C_double(val));
- return(val);
- }
-
-
- static Xen g_sample_to_file_add(Xen obj1, Xen obj2)
- {
- #define H_sample_to_file_add "(" S_sample_to_file_add " obj1 obj2): mixes obj2 (an output generator) into obj1 (also an output generator)"
- mus_any *g1 = NULL, *g2 = NULL;
- mus_xen *gn1, *gn2;
-
- Xen_to_C_any_generator(obj1, gn1, g1, S_sample_to_file_add, "an output generator");
- Xen_to_C_any_generator(obj2, gn2, g2, S_sample_to_file_add, "an output generator");
- Xen_check_type(mus_is_output(g1), obj1, 1, S_sample_to_file_add, "an output generator");
- Xen_check_type(mus_is_output(g2), obj2, 2, S_sample_to_file_add, "an output generator");
-
- mus_sample_to_file_add(g1, g2);
- return(obj1);
- }
-
- static Xen g_make_file_to_frample(Xen name, Xen buffer_size)
- {
- #define H_make_file_to_frample "(" S_make_file_to_frample " filename buffer-size): return an input generator reading 'filename' (a sound file)"
-
- mus_any *ge;
- mus_long_t size;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_file_to_frample, "a string");
- Xen_check_type(Xen_is_llong_or_unbound(buffer_size), buffer_size, 2, S_make_file_to_frample, "an integer");
-
- if (!(mus_file_probe(Xen_string_to_C_string(name))))
- Xen_error(NO_SUCH_FILE,
- Xen_list_3(C_string_to_Xen_string(S_make_file_to_frample ": ~S, ~A"),
- name,
- C_string_to_Xen_string(STRERROR(errno))));
-
- if (Xen_is_llong(buffer_size))
- {
- size = Xen_llong_to_C_llong(buffer_size);
- if (size <= 0)
- Xen_out_of_range_error(S_make_file_to_frample, 2, buffer_size, "must be > 0");
- }
- else size = mus_file_buffer_size();
- ge = mus_make_file_to_frample_with_buffer_size(Xen_string_to_C_string(name), size);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_file_to_frample(Xen obj, Xen samp, Xen outfr)
- {
- #define H_file_to_frample "(" S_file_to_frample " obj samp outf): frample of samples at frample 'samp' in sound file read by 'obj'"
-
- Xen_check_type((mus_is_xen(obj)) && (mus_is_input(Xen_to_mus_any(obj))), obj, 1, S_file_to_frample, "an input generator");
- Xen_check_type(Xen_is_integer(samp), samp, 2, S_file_to_frample, "an integer");
-
- mus_file_to_frample(Xen_to_mus_any(obj), Xen_llong_to_C_llong(samp), mus_vct_data(Xen_to_vct(outfr)));
- return(outfr);
- }
-
-
- static Xen g_make_frample_to_file(Xen name, Xen chans, Xen out_format, Xen out_type, Xen comment)
- {
- #if HAVE_SCHEME
- #define make_frample_to_file_example "(" S_make_frample_to_file " \"test.snd\" 2 mus-lshort mus-riff)"
- #endif
- #if HAVE_RUBY
- #define make_frample_to_file_example "\"test.snd\" 2 Mus_lshort Mus_riff make_frample2file"
- #endif
- #if HAVE_FORTH
- #define make_frample_to_file_example "\"test.snd\" 2 mus-lshort mus-riff make-frample->file"
- #endif
-
- #define H_make_frample_to_file "(" S_make_frample_to_file " filename chans sample-type header-type comment): \
- return an output generator writing the sound file 'filename' which is set up to have \
- 'chans' channels of 'sample-type' samples with a header of 'header-type'. The latter \
- should be sndlib identifiers:\n " make_frample_to_file_example
-
- mus_any *fgen = NULL;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_frample_to_file, "a string");
- Xen_check_type(Xen_is_integer_or_unbound(chans), chans, 2, S_make_frample_to_file, "an integer");
- Xen_check_type(Xen_is_integer_or_unbound(out_format), out_format, 3, S_make_frample_to_file, "an integer (sample type id)");
- Xen_check_type(Xen_is_integer_or_unbound(out_type), out_type, 4, S_make_frample_to_file, "an integer (header-type id)");
-
- fgen = mus_make_frample_to_file_with_comment(Xen_string_to_C_string(name),
- (Xen_is_integer(chans)) ? Xen_integer_to_C_int(chans) : 1,
- (Xen_is_integer(out_format)) ? (mus_sample_t)Xen_integer_to_C_int(out_format) : MUS_OUT_SAMPLE_TYPE,
- (Xen_is_integer(out_type)) ? (mus_header_t)Xen_integer_to_C_int(out_type) : MUS_NEXT,
- (Xen_is_string(comment)) ? Xen_string_to_C_string(comment) : NULL);
- if (fgen) return(mus_xen_to_object(mus_any_to_mus_xen(fgen)));
- return(Xen_false);
- }
-
-
- static Xen g_continue_frample_to_file(Xen name)
- {
- #define H_continue_frample_to_file "(" S_continue_frample_to_file " filename): return an output generator \
- that reopens an existing sound file 'filename' ready for output via " S_frample_to_file
-
- mus_any *rgen = NULL;
- Xen_check_type(Xen_is_string(name), name, 1, S_continue_frample_to_file, "a string");
- rgen = mus_continue_frample_to_file(Xen_string_to_C_string(name));
- if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- return(Xen_false);
- }
-
-
- static Xen g_frample_to_file(Xen obj, Xen samp, Xen val)
- {
- #define H_frample_to_file "(" S_frample_to_file " obj samp val): add frample 'val' to the output stream \
- handled by the output generator 'obj' at frample 'samp'"
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(obj, mus_xen_tag);
- Xen_check_type(((gn) && (mus_is_output(gn->gen))), obj, 1, S_frample_to_file, "an output generator");
- Xen_check_type(Xen_is_integer(samp), samp, 2, S_frample_to_file, "an integer");
-
- mus_frample_to_file(gn->gen, Xen_llong_to_C_llong(samp), mus_vct_data(Xen_to_vct(val)));
- return(val);
- }
-
-
-
-
- /* ---------------- readin ---------------- */
-
- static Xen g_is_readin(Xen obj)
- {
- #define H_is_readin "(" S_is_readin " gen): " PROC_TRUE " if gen is a " S_readin
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_readin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_readin(Xen obj)
- {
- #define H_readin "(" S_readin " gen): next sample from readin generator (a sound file reader)"
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_readin, S_readin, "a readin generator");
-
- return(C_double_to_Xen_real(mus_readin(g)));
- }
-
-
- static Xen g_make_readin(Xen arglist)
- {
- #define H_make_readin "(" S_make_readin " file (channel 0) (start 0) (direction 1) size): \
- return a new readin (file input) generator reading the sound file 'file' starting at frample \
- 'start' in channel 'channel' and reading forward if 'direction' is not -1"
-
- /* optkey file channel start direction size */
-
- mus_any *ge;
- const char *file = NULL;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals, chans;
- mus_long_t buffer_size;
- int channel = 0, direction = 1;
- mus_long_t start = 0;
-
- keys[0] = kw_file;
- keys[1] = kw_channel;
- keys[2] = kw_start;
- keys[3] = kw_direction;
- keys[4] = kw_size;
-
- buffer_size = mus_file_buffer_size();
- /* this is only 8192! (clm.h MUS_DEFAULT_FILE_BUFFER_SIZE) */
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_readin, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_readin, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- file = mus_optkey_to_string(keys[0], S_make_readin, orig_arg[0], NULL); /* not copied */
-
- channel = Xen_optkey_to_int(kw_channel, keys[1], S_make_readin, orig_arg[1], channel);
- if (channel < 0)
- Xen_out_of_range_error(S_make_readin, orig_arg[1], keys[1], "channel < 0?");
-
- start = Xen_optkey_to_mus_long_t(kw_start, keys[2], S_make_readin, orig_arg[2], start);
-
- direction = Xen_optkey_to_int(kw_direction, keys[3], S_make_readin, orig_arg[3], direction);
-
- buffer_size = Xen_optkey_to_mus_long_t(kw_size, keys[4], S_make_readin, orig_arg[4], buffer_size);
- if (buffer_size <= 0)
- Xen_out_of_range_error(S_make_readin, orig_arg[4], keys[4], "must be > 0");
- }
-
- if (file == NULL)
- Xen_out_of_range_error(S_make_readin, orig_arg[0], keys[0], "no file name given");
- if (!(mus_file_probe(file)))
- Xen_error(NO_SUCH_FILE,
- Xen_list_3(C_string_to_Xen_string(S_make_readin ": ~S, ~A"),
- C_string_to_Xen_string(file),
- C_string_to_Xen_string(STRERROR(errno))));
-
- chans = mus_sound_chans(file);
- if (chans <= 0)
- Xen_error(BAD_HEADER,
- Xen_list_2(C_string_to_Xen_string(S_make_readin ": ~S chans <= 0?"),
- C_string_to_Xen_string(file)));
-
- if (channel >= chans)
- Xen_out_of_range_error(S_make_readin, orig_arg[1], keys[1], "channel > available chans?");
-
- ge = mus_make_readin_with_buffer_size(file, channel, start, direction, buffer_size);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- /* ---------------- locsig ---------------- */
-
- static Xen g_locsig_ref(Xen obj, Xen chan)
- {
- #define H_locsig_ref "(" S_locsig_ref " gen chan): locsig 'gen' channel 'chan' scaler"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_ref, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_ref, "an integer");
- return(C_double_to_Xen_real(mus_locsig_ref(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan))));
- }
-
-
- static Xen g_locsig_set(Xen obj, Xen chan, Xen val)
- {
- #define H_locsig_set "(" S_locsig_set " gen chan val): set the locsig generator's channel 'chan' scaler to 'val'"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_set, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_set, "an integer");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(val), val, 3, S_locsig_set, "a number");
- mus_locsig_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), Xen_real_to_C_double(val));
- #else
- mus_locsig_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), s7_number_to_real_with_caller(s7, val, S_locsig_set));
- #endif
- return(val);
- }
-
-
- static Xen g_locsig_reverb_ref(Xen obj, Xen chan)
- {
- #define H_locsig_reverb_ref "(" S_locsig_reverb_ref " gen chan): locsig reverb channel 'chan' scaler"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_reverb_ref, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_reverb_ref, "an integer");
- return(C_double_to_Xen_real(mus_locsig_reverb_ref(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan))));
- }
-
-
- static Xen g_locsig_reverb_set(Xen obj, Xen chan, Xen val)
- {
- #define H_locsig_reverb_set "(" S_locsig_reverb_set " gen chan val): set the locsig reverb channel 'chan' scaler to 'val'"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_reverb_set, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_reverb_set, "an integer");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(val), val, 3, S_locsig_reverb_set, "a number");
- mus_locsig_reverb_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), Xen_real_to_C_double(val));
- #else
- mus_locsig_reverb_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), s7_number_to_real_with_caller(s7, val, S_locsig_reverb_set));
- #endif
- return(val);
- }
-
-
- static Xen g_is_locsig(Xen obj)
- {
- #define H_is_locsig "(" S_is_locsig " gen): " PROC_TRUE " if gen is a " S_locsig
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj)))));
- }
-
-
- static void mus_locsig_or_move_sound_to_vct_or_sound_data(mus_xen *ms, mus_any *loc_gen, mus_long_t pos, bool from_locsig)
- {
- mus_float_t *outfr = NULL, *revfr = NULL;
- Xen output, reverb;
- #if HAVE_SCHEME
- int chans, rev_chans;
- #endif
- if (pos < 0) return;
-
- if (from_locsig)
- {
- outfr = mus_locsig_outf(loc_gen);
- revfr = mus_locsig_revf(loc_gen);
- #if HAVE_SCHEME
- chans = mus_locsig_channels(loc_gen);
- rev_chans = mus_locsig_reverb_channels(loc_gen);
- #endif
- }
- else
- {
- outfr = mus_move_sound_outf(loc_gen);
- revfr = mus_move_sound_revf(loc_gen);
- #if HAVE_SCHEME
- chans = mus_move_sound_channels(loc_gen);
- rev_chans = mus_move_sound_reverb_channels(loc_gen);
- #endif
- }
- output = ms->vcts[G_LOCSIG_OUT];
-
- if (outfr)
- {
- if (mus_is_vct(output))
- {
- vct *v;
- mus_float_t *vdata;
- v = Xen_to_vct(output);
- vdata = mus_vct_data(v);
- if (Xen_vector_rank(output) == 1)
- {
- if (pos < mus_vct_length(v))
- vdata[pos] += outfr[0];
- }
- #if HAVE_SCHEME
- else
- {
- s7_int chan_len;
- chan_len = s7_vector_dimensions(output)[1]; /* '(4 20) so each chan len is [1] */
- if (pos < chan_len)
- {
- int i;
- for (i = 0; i < chans; i++)
- vdata[i * chan_len + pos] += outfr[i];
- }
- }
- #endif
- }
- else
- {
- if ((Xen_is_vector(output)) &&
- (pos < Xen_vector_length(output)))
- Xen_vector_set(output, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(output, pos)) + outfr[0]));
- }
- }
-
- if ((revfr) &&
- (Xen_is_bound(ms->vcts[G_LOCSIG_REVOUT])))
- {
- reverb = ms->vcts[G_LOCSIG_REVOUT];
- if (mus_is_vct(reverb))
- {
- vct *v;
- mus_float_t *vdata;
- v = Xen_to_vct(reverb);
- vdata = mus_vct_data(v);
- if (Xen_vector_rank(reverb) == 1)
- {
- if (pos < mus_vct_length(v))
- vdata[pos] += revfr[0];
- }
- #if HAVE_SCHEME
- else
- {
- s7_int chan_len;
- chan_len = s7_vector_dimensions(reverb)[1];
- if (pos < chan_len)
- {
- int i;
- for (i = 0; i < rev_chans; i++)
- vdata[i * chan_len + pos] += revfr[i];
- }
- }
- #endif
- }
- else
- {
- if ((Xen_is_vector(reverb)) &&
- (pos < Xen_vector_length(reverb)))
- Xen_vector_set(reverb, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(reverb, pos)) + revfr[0]));
- }
- }
- }
-
-
- static Xen g_locsig(Xen xobj, Xen xpos, Xen xval)
- {
- #define H_locsig "(" S_locsig " gen loc val): add 'val' to the output of locsig at frample 'loc'"
- mus_any *loc_gen;
- mus_xen *ms;
- mus_long_t pos;
- mus_float_t fval;
-
- ms = (mus_xen *)Xen_object_ref_checked(xobj, mus_xen_tag);
- if (!ms) Xen_check_type(false, xobj, 1, S_locsig, "a locsig generator");
- loc_gen = ms->gen;
- Xen_check_type(mus_is_locsig(loc_gen), xobj, 1, S_locsig, "a locsig generator");
-
- Xen_check_type(Xen_is_integer(xpos), xpos, 2, S_locsig, "an integer");
-
- pos = Xen_llong_to_C_llong(xpos);
- if (pos < 0)
- Xen_out_of_range_error(S_locsig, 2, xpos, "must be >= 0");
-
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(xval), xval, 3, S_locsig, "a number");
- fval = Xen_real_to_C_double(xval);
- #else
- fval = s7_number_to_real_with_caller(s7, xval, S_locsig);
- #endif
-
- mus_locsig(loc_gen, pos, fval);
-
- return(xval); /* changed 30-June-06 to return val rather than a wrapped frample */
- }
-
- static mus_interp_t clm_locsig_type = MUS_INTERP_LINEAR;
-
- static Xen g_locsig_type(void)
- {
- #define H_locsig_type "(" S_locsig_type "): locsig interpolation type, either " S_mus_interp_linear " or " S_mus_interp_sinusoidal "."
- return(C_int_to_Xen_integer((int)clm_locsig_type));
- }
-
-
- static Xen g_set_locsig_type(Xen val)
- {
- mus_interp_t newval;
- Xen_check_type(Xen_is_integer(val), val, 1, S_locsig_type, S_mus_interp_linear " or " S_mus_interp_sinusoidal);
- newval = (mus_interp_t)Xen_integer_to_C_int(val);
- if ((newval == MUS_INTERP_LINEAR) || (newval == MUS_INTERP_SINUSOIDAL))
- clm_locsig_type = newval;
- return(C_int_to_Xen_integer((int)clm_locsig_type));
- }
-
-
- static void clm_locsig_detour(mus_any *ptr, mus_long_t pos)
- {
- mus_xen *ms;
- ms = (mus_xen *)mus_locsig_closure(ptr);
- /* now check for vct/sound-data special cases */
- if (ms->nvcts == 4)
- mus_locsig_or_move_sound_to_vct_or_sound_data(ms, ms->gen, pos, true);
- }
-
- static Xen g_make_locsig(Xen arglist)
- {
- #define H_make_locsig "(" S_make_locsig " (degree 0.0) (distance 1.0) (reverb 0.0) (output *output*) (revout *reverb*) (channels (mus-channels *output*)) (type " S_mus_interp_linear ")): \
- return a new generator for signal placement in n channels. Channel 0 corresponds to 0 degrees."
-
- mus_any *ge;
- mus_any *outp = NULL, *revp = NULL;
- Xen args[14];
- Xen keys[7];
- Xen ov = Xen_undefined, rv = Xen_undefined;
- Xen keys3 = Xen_undefined, keys4 = Xen_undefined;
- int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
- int vals, out_chans = -1, rev_chans = -1;
- mus_interp_t type;
- mus_float_t degree = 0.0, distance = 1.0, reverb = 0.0;
-
- type = clm_locsig_type;
-
- keys[0] = kw_degree;
- keys[1] = kw_distance;
- keys[2] = kw_reverb;
- keys[3] = kw_output;
- keys[4] = kw_revout;
- keys[5] = kw_channels;
- keys[6] = kw_type;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 14) clm_error(S_make_locsig, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 14; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_locsig, 7, keys, args, orig_arg);
- if (vals > 0)
- {
- degree = Xen_optkey_to_float(kw_degree, keys[0], S_make_locsig, orig_arg[0], degree);
- distance = Xen_optkey_to_float(kw_distance, keys[1], S_make_locsig, orig_arg[1], distance);
- reverb = Xen_optkey_to_float(kw_reverb, keys[2], S_make_locsig, orig_arg[2], reverb);
-
- if (!(Xen_is_keyword(keys[3])))
- keys3 = keys[3];
-
- if (!(Xen_is_keyword(keys[4])))
- keys4 = keys[4];
-
- if (!(Xen_is_keyword(keys[5])))
- {
- Xen_check_type(Xen_is_integer(keys[5]), keys[5], orig_arg[5], S_make_locsig, "an integer");
- out_chans = Xen_integer_to_C_int(keys[5]);
- if (out_chans < 0)
- Xen_out_of_range_error(S_make_locsig, orig_arg[5], keys[5], "chans < 0?");
- if (out_chans > mus_max_table_size())
- Xen_out_of_range_error(S_make_locsig, orig_arg[5], keys[5], "too many chans");
- }
-
- type = (mus_interp_t)Xen_optkey_to_int(kw_type, keys[6], S_make_locsig, orig_arg[6], (int)type);
- if ((type != MUS_INTERP_LINEAR) && (type != MUS_INTERP_SINUSOIDAL))
- Xen_out_of_range_error(S_make_locsig, orig_arg[6], keys[6], "type must be " S_mus_interp_linear " or " S_mus_interp_sinusoidal ".");
- }
-
- if (!Xen_is_bound(keys3))
- keys3 = CLM_OUTPUT;
-
- if (!Xen_is_bound(keys4))
- keys4 = CLM_REVERB;
-
- /* try to default output to *output* and reverb to *reverb*, if they're currently set and not closed */
- /* mus_close is actually mus_close_file = sample_to_file_end = free and nullify obufs so we're hoping dynamic-wind works... */
-
- if ((mus_is_xen(keys3)) &&
- (mus_is_output(Xen_to_mus_any(keys3))))
- {
- outp = (mus_any *)Xen_to_mus_any(keys3);
- if (out_chans < 0)
- out_chans = mus_channels((mus_any *)outp);
- }
- else
- {
- if (mus_is_vct(keys3))
- ov = keys3;
- else Xen_check_type(Xen_is_keyword(keys[3]) || Xen_is_false(keys[3]), keys[3], orig_arg[3], S_make_locsig, "an output gen, " S_vct ", vector, or a sound-data object");
- #if HAVE_SCHEME
- if ((out_chans < 0) &&
- (s7_is_vector(ov)) &&
- (s7_vector_rank(ov) > 1))
- out_chans = s7_vector_dimensions(ov)[0];
- #endif
- }
-
- if ((mus_is_xen(keys4)) &&
- (mus_is_output(Xen_to_mus_any(keys4))))
- {
- revp = (mus_any *)Xen_to_mus_any(keys4);
- if (rev_chans < 0)
- rev_chans = mus_channels((mus_any *)revp);
- }
- else
- {
- if (mus_is_vct(keys4))
- {
- rv = keys4;
- rev_chans = 1;
- #if HAVE_SCHEME
- if (Xen_vector_rank(rv) > 1)
- rev_chans = s7_vector_dimensions(rv)[0];
- #endif
- }
- else Xen_check_type(Xen_is_keyword(keys[4]) || Xen_is_false(keys[4]), keys[4], orig_arg[4], S_make_locsig, "a reverb output generator");
- }
-
- if (out_chans < 0) out_chans = 1;
- if (rev_chans < 0) rev_chans = 0;
-
- ge = mus_make_locsig(degree, distance, reverb, out_chans, outp, rev_chans, revp, type);
-
- if (ge)
- {
- mus_xen *gn;
- if (((Xen_is_bound(ov)) && (!Xen_is_false(ov))) ||
- ((Xen_is_bound(rv)) && (!Xen_is_false(rv))))
- gn = mx_alloc(4);
- else gn = mx_alloc(2);
-
- /* these two are for the mus-data and mus-xcoeffs methods in Scheme (etc) = MUS_DATA_WRAPPER and G_FILTER_XCOEFFS */
- if (out_chans > 0)
- gn->vcts[G_LOCSIG_DATA] = xen_make_vct_wrapper(out_chans, mus_data(ge));
- else gn->vcts[G_LOCSIG_DATA] = Xen_undefined;
- if (rev_chans > 0)
- gn->vcts[G_LOCSIG_REVDATA] = xen_make_vct_wrapper(rev_chans, mus_xcoeffs(ge));
- else gn->vcts[G_LOCSIG_REVDATA] = Xen_undefined;
-
- if (gn->nvcts == 4)
- {
- mus_locsig_set_detour(ge, clm_locsig_detour);
- gn->vcts[G_LOCSIG_OUT] = ov;
- gn->vcts[G_LOCSIG_REVOUT] = rv;
- mus_set_environ(ge, (void *)gn);
- }
-
- gn->gen = ge;
- return(mus_xen_to_object(gn));
- }
- return(Xen_false);
- }
-
-
- static Xen g_move_locsig(Xen obj, Xen degree, Xen distance)
- {
- #define H_move_locsig "(" S_move_locsig " gen degree distance): move locsig gen to reflect degree and distance"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_move_locsig, "a locsig generator");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(degree), degree, 2, S_move_locsig, "a number in degrees");
- Xen_check_type(Xen_is_number(distance), distance, 3, S_move_locsig, "a number > 1.0");
- mus_move_locsig(Xen_to_mus_any(obj), Xen_real_to_C_double(degree), Xen_real_to_C_double(distance));
- #else
- mus_move_locsig(Xen_to_mus_any(obj),
- s7_number_to_real_with_caller(s7, degree, S_move_locsig),
- s7_number_to_real_with_caller(s7, distance, S_move_locsig));
- #endif
- return(obj);
- }
-
-
-
-
- /* ---------------- move-sound ---------------- */
-
- static Xen g_is_move_sound(Xen obj)
- {
- #define H_is_move_sound "(" S_is_move_sound " gen): " PROC_TRUE " if gen is a " S_move_sound
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_move_sound(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_move_sound(Xen obj, Xen loc, Xen val)
- {
- #define H_move_sound "(" S_move_sound " gen loc val): dlocsig run-time generator handling 'val' at sample 'loc'"
- mus_any *move_gen;
- mus_xen *ms;
- mus_long_t pos;
- mus_float_t fval;
-
- Xen_check_type(mus_is_xen(obj), obj, 1, S_move_sound, "a move-sound generator");
- ms = Xen_to_mus_xen(obj);
- move_gen = (mus_any *)(ms->gen);
-
- Xen_check_type(mus_is_move_sound(move_gen), obj, 1, S_move_sound, "a move-sound generator");
- Xen_check_type(Xen_is_integer(loc), loc, 2, S_move_sound, "an integer");
- Xen_check_type(Xen_is_number(val), val, 3, S_move_sound, "a number");
-
- pos = Xen_llong_to_C_llong(loc);
- if (pos < 0)
- Xen_out_of_range_error(S_move_sound, 2, loc, "must be >= 0");
- fval = Xen_real_to_C_double(val);
-
- mus_move_sound(move_gen, pos, fval);
- return(val);
- }
-
-
- static mus_any **xen_vector_to_mus_any_array(Xen vect)
- {
- mus_any **gens;
- mus_long_t i, len;
-
- if (!(Xen_is_vector(vect))) return(NULL);
- len = Xen_vector_length(vect);
- gens = (mus_any **)calloc(len, sizeof(mus_any *));
-
- for (i = 0; i < len; i++)
- if (mus_is_xen(Xen_vector_ref(vect, i)))
- gens[i] = Xen_to_mus_any(Xen_vector_ref(vect, i));
- return(gens);
- }
-
-
- static int *xen_vector_to_int_array(Xen vect)
- {
- int *vals;
- mus_long_t i, len;
-
- len = Xen_vector_length(vect);
- vals = (int *)calloc(len, sizeof(int));
-
- for (i = 0; i < len; i++)
- vals[i] = Xen_integer_to_C_int(Xen_vector_ref(vect, i));
- return(vals);
- }
-
-
- static void clm_move_sound_detour(mus_any *ptr, mus_long_t pos)
- {
- mus_xen *ms;
- ms = (mus_xen *)mus_move_sound_closure(ptr);
- /* now check for vct/sound-data special cases */
- if (ms->nvcts == 4)
- mus_locsig_or_move_sound_to_vct_or_sound_data(ms, ms->gen, pos, false);
- }
-
-
- static Xen g_make_move_sound(Xen dloc_list, Xen outp, Xen revp)
- {
- Xen ov = Xen_undefined, rv = Xen_undefined;
- mus_any *ge, *dopdly, *dopenv, *globrevenv = NULL, *output = NULL, *revput = NULL;
- mus_any **out_delays, **out_envs, **rev_envs;
- int *out_map;
- mus_long_t start, end;
- int outchans = 0, revchans = 0;
- Xen ref;
-
- #define H_make_move_sound "(" S_make_move_sound " dloc-list (out *output*) (rev *reverb*)): make a dlocsig run-time generator"
-
- /* dloc-list is (list start end outchans revchans dopdly dopenv revenv outdelays outenvs revenvs outmap) */
- /* outdelays envs and revenvs are vectors */
-
- Xen_check_type(Xen_is_list(dloc_list) && (Xen_list_length(dloc_list) == 11), dloc_list, 1, S_make_move_sound, "a dlocsig list");
-
- if (!Xen_is_bound(outp))
- outp = CLM_OUTPUT;
-
- if (!Xen_is_bound(revp))
- revp = CLM_REVERB;
-
- if (mus_is_xen(outp))
- {
- output = Xen_to_mus_any(outp);
- Xen_check_type(mus_is_output(output), outp, 2, S_make_move_sound, "output stream");
- }
- else
- {
- if ((mus_is_vct(outp)) ||
- (Xen_is_false(outp)) ||
- (!Xen_is_bound(outp)))
- ov = outp;
- else Xen_check_type(false, outp, 2, S_make_move_sound, "output stream, " S_vct ", or a sound-data object");
- }
-
- if (mus_is_xen(revp))
- {
- revput = Xen_to_mus_any(revp);
- Xen_check_type(mus_is_output(revput), revp, 3, S_make_move_sound, "reverb stream");
- }
- else
- {
- if ((mus_is_vct(revp)) ||
- (Xen_is_false(revp)) ||
- (!Xen_is_bound(revp)))
- rv = revp;
- else Xen_check_type(false, revp, 3, S_make_move_sound, "reverb stream, " S_vct ", or a sound-data object");
- }
-
- ref = Xen_list_ref(dloc_list, 0);
- Xen_check_type(Xen_is_llong(ref), ref, 1, S_make_move_sound, "dlocsig list[0] (start): a sample number");
- start = Xen_llong_to_C_llong(ref);
-
- ref = Xen_list_ref(dloc_list, 1);
- Xen_check_type(Xen_is_llong(ref), ref, 1, S_make_move_sound, "dlocsig list[1] (end): a sample number");
- end = Xen_llong_to_C_llong(ref);
-
- ref = Xen_list_ref(dloc_list, 2);
- Xen_check_type(Xen_is_integer(ref), ref, 1, S_make_move_sound, "dlocsig list[2] (outchans): an integer");
- outchans = Xen_integer_to_C_int(ref);
-
- ref = Xen_list_ref(dloc_list, 3);
- Xen_check_type(Xen_is_integer(ref), ref, 1, S_make_move_sound, "dlocsig list[3] (revchans): an integer");
- revchans = Xen_integer_to_C_int(ref);
-
- ref = Xen_list_ref(dloc_list, 4);
- Xen_check_type(mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
- dopdly = Xen_to_mus_any(ref);
- Xen_check_type(mus_is_delay(dopdly), ref, 1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
-
- ref = Xen_list_ref(dloc_list, 5);
- Xen_check_type(mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
- dopenv = Xen_to_mus_any(ref);
- Xen_check_type(mus_is_env(dopenv), ref, 1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
-
- ref = Xen_list_ref(dloc_list, 6);
- Xen_check_type(Xen_is_false(ref) || mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
- if (mus_is_xen(ref))
- {
- globrevenv = Xen_to_mus_any(ref);
- Xen_check_type(mus_is_env(globrevenv), ref, 1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
- }
-
- ref = Xen_list_ref(dloc_list, 7);
- Xen_check_type(Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans),
- ref, 1, S_make_move_sound, "dlocsig list[7] (out delays): a vector of delay gens");
-
- ref = Xen_list_ref(dloc_list, 8);
- Xen_check_type(Xen_is_false(ref) || (Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans)),
- ref, 1, S_make_move_sound, "dlocsig list[8] (out envs): " PROC_FALSE " or a vector of envs");
-
- ref = Xen_list_ref(dloc_list, 9);
- Xen_check_type(Xen_is_false(ref) || (Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= revchans)),
- ref, 1, S_make_move_sound, "dlocsig list[9] (rev envs): " PROC_FALSE " or a vector of envs");
-
- ref = Xen_list_ref(dloc_list, 10);
- Xen_check_type(Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans),
- ref, 1, S_make_move_sound, "dlocsig list[10] (out map): vector of ints");
-
- /* put off allocation until all type error checks are done */
-
- out_delays = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 7));
- out_envs = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 8));
- rev_envs = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 9));
- out_map = xen_vector_to_int_array(Xen_list_ref(dloc_list, 10));
-
- ge = mus_make_move_sound(start, end, outchans, revchans,
- dopdly, dopenv, globrevenv,
- out_delays, out_envs, rev_envs, out_map,
- output, revput,
- true, false); /* free outer arrays but not gens */
- if (ge)
- {
- mus_xen *gn;
- if (((Xen_is_bound(ov)) && (!Xen_is_false(ov))) ||
- ((Xen_is_bound(rv)) && (!Xen_is_false(rv))))
- gn = mx_alloc(4);
- else gn = mx_alloc(1);
- gn->vcts[G_LOCSIG_DATA] = dloc_list; /* it is crucial that the list be gc-protected! */
- if (gn->nvcts == 4)
- {
- mus_move_sound_set_detour(ge, clm_move_sound_detour);
- gn->vcts[G_LOCSIG_OUT] = ov;
- gn->vcts[G_LOCSIG_REVOUT] = rv;
- gn->vcts[G_LOCSIG_REVDATA] = Xen_undefined;
- mus_set_environ(ge, (void *)gn);
- }
- gn->gen = ge;
- return(mus_xen_to_object(gn));
- }
-
- return(Xen_false);
- }
-
-
-
-
- /* ---------------- src ---------------- */
-
- static Xen xen_one, xen_minus_one;
-
- #if HAVE_SCHEME
- static Xen as_needed_arglist;
-
- static s7_pointer env_symbol, polywave_symbol, triangle_wave_symbol, rand_interp_symbol, oscil_symbol;
- static s7_pointer multiply_symbol, add_symbol, vector_ref_symbol, quote_symbol, cos_symbol, comb_bank_symbol;
-
-
- static mus_float_t as_needed_input_float(void *ptr, int direction)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(s7_real(gn->vcts[MUS_INPUT_DATA]));
- }
-
- static mus_float_t as_needed_block_input_float(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- mus_xen *gn = (mus_xen *)ptr;
- mus_float_t val;
- mus_long_t i, lim4;
-
- lim4 = end - 4;
- val = (mus_float_t)s7_real(gn->vcts[MUS_INPUT_DATA]); /* set in the chooser below */
-
- for (i = start; i <= lim4;)
- {
- data[i++] = val;
- data[i++] = val;
- data[i++] = val;
- data[i++] = val;
- }
- for (;i < end; i++)
- data[i] = val;
- return(val);
- }
-
-
- static mus_float_t as_needed_input_any(void *ptr, int direction)
- {
- mus_xen *gn = (mus_xen *)ptr;
- s7_set_car(as_needed_arglist, (direction == 1) ? xen_one : xen_minus_one);
- return(s7_number_to_real(s7, s7_apply_function(s7, gn->vcts[MUS_INPUT_FUNCTION], as_needed_arglist)));
- }
- #endif
-
-
- static mus_float_t as_needed_input_generator(void *ptr, int direction)
- {
- #if HAVE_EXTENSION_LANGUAGE
- return(mus_apply((mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]), 0.0, 0.0));
- #else
- return(0.0);
- #endif
- }
-
- static mus_float_t as_needed_block_input_generator(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- #if HAVE_EXTENSION_LANGUAGE
- mus_any *g;
- mus_long_t i;
- g = (mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = mus_apply(g, 0.0, 0.0);
- #endif
- return(0.0);
- }
-
-
- static mus_float_t as_needed_input_readin(void *ptr, int direction)
- {
- #if HAVE_EXTENSION_LANGUAGE
- return(mus_readin((mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA])));
- #else
- return(0.0);
- #endif
- }
-
- static mus_float_t as_needed_block_input_readin(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- #if HAVE_EXTENSION_LANGUAGE
- mus_any *g;
- mus_long_t i;
- g = (mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = mus_readin(g);
- #endif
- return(0.0);
- }
-
-
- #if USE_SND && HAVE_SCHEME
- static mus_float_t as_needed_input_sampler(void *ptr, int direction)
- {
- return(read_sample((snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA])));
- }
-
- static mus_float_t as_needed_block_input_sampler(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- snd_fd *p;
- mus_long_t i;
- p = (snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = read_sample(p);
- return(0.0);
- }
-
-
- mus_float_t read_sample_with_direction(void *p, int dir);
- static mus_float_t as_needed_input_sampler_with_direction(void *ptr, int direction)
- {
- return(read_sample_with_direction((snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]), direction));
- }
-
- static mus_float_t as_needed_block_input_sampler_with_direction(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- snd_fd *p;
- mus_long_t i;
- p = (snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = read_sample_with_direction(p, direction);
- return(0.0);
- }
- #endif
-
-
- static mus_float_t as_needed_input_func(void *ptr, int direction) /* intended for "as-needed" input funcs */
- {
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- Xen in_obj;
- in_obj = gn->vcts[MUS_INPUT_FUNCTION];
- if (Xen_is_procedure(in_obj))
- return(Xen_real_to_C_double(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_INPUT_FUNCTION], (direction == 1) ? xen_one : xen_minus_one)));
- }
- return(0.0);
- }
-
- #if HAVE_SCHEME
- static mus_float_t as_needed_input_rf(void *ptr, int direction)
- {
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- s7_rf_t rf;
- s7_pointer *top, *p;
- rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
- top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
- p = top;
- return(rf(s7, &p));
- }
- return(0.0);
- }
-
- static mus_float_t as_needed_block_input_rf(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- mus_long_t i;
- s7_rf_t rf;
- s7_pointer *top, *p;
- rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
- top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
- for (i = start; i < end; i++)
- {
- p = top;
- data[i] = rf(s7, &p);
- }
- }
- return(0.0);
- }
- #endif
-
- static void set_as_needed_input_choices(mus_any *gen, Xen obj, mus_xen *gn)
- {
- /* fprintf(stderr, "set_as_needed_input for %s: %s\n", mus_name(gen), DISPLAY(obj)); */
- if (mus_is_xen(obj)) /* input function is a generator */
- {
- mus_any *p;
- p = Xen_to_mus_any(obj);
- if (p)
- {
- #if HAVE_EXTENSION_LANGUAGE
- gn->vcts[MUS_INPUT_DATA] = (Xen)p;
- #endif
- if (mus_is_readin(p))
- mus_generator_set_feeders(gen, as_needed_input_readin, as_needed_block_input_readin);
- else mus_generator_set_feeders(gen, as_needed_input_generator, as_needed_block_input_generator);
- return;
- }
- }
-
- #if HAVE_SCHEME
- if ((Xen_is_procedure(obj)) &&
- (!Xen_is_procedure(gn->vcts[MUS_ANALYZE_FUNCTION]))) /* this assumes scheme-ready input function at least in phase-vocoder case */
- {
- s7_pointer body;
- body = s7_closure_body(s7, obj);
- if (s7_is_pair(body))
- {
- if (s7_is_null(s7, s7_cdr(body)))
- {
- s7_pointer res;
- res = s7_car(body);
- if (s7_is_real(res))
- {
- gn->vcts[MUS_INPUT_DATA] = res;
- mus_generator_set_feeders(gen, as_needed_input_float, as_needed_block_input_float);
- return;
- }
- if (s7_is_pair(res))
- {
- if (s7_is_symbol(s7_car(res)))
- {
- s7_pointer fcar;
- fcar = s7_symbol_value(s7, s7_car(res));
- if (s7_rf_function(s7, fcar))
- {
- s7_rf_t rf;
- s7_pointer old_e, e;
- e = s7_sublet(s7, s7_closure_let(s7, obj), s7_nil(s7));
- old_e = s7_set_curlet(s7, e);
- s7_xf_new(s7, e);
- rf = s7_rf_function(s7, fcar)(s7, res);
- if (rf)
- {
- gn->vcts[MUS_SAVED_FUNCTION] = gn->vcts[MUS_INPUT_FUNCTION]; /* needed for GC protection */
- gn->vcts[MUS_INPUT_DATA] = (s7_pointer)s7_xf_detach(s7);
- gn->vcts[MUS_INPUT_FUNCTION] = (s7_pointer)rf;
- gn->free_data = true;
- mus_generator_set_feeders(gen, as_needed_input_rf, as_needed_block_input_rf);
- s7_set_curlet(s7, old_e);
- return;
- }
- s7_xf_free(s7);
- s7_set_curlet(s7, old_e);
- }
- }
- #if USE_SND
- {
- s7_pointer arg;
- arg = s7_car(s7_closure_args(s7, obj));
- if ((arg == s7_caddr(res)) &&
- (s7_car(res) == s7_make_symbol(s7, "read-sample-with-direction")))
- {
- gn->vcts[MUS_INPUT_DATA] = (Xen)xen_to_sampler(s7_symbol_local_value(s7, s7_cadr(res), s7_closure_let(s7, obj)));
- mus_generator_set_feeders(gen, as_needed_input_sampler_with_direction, as_needed_block_input_sampler_with_direction);
- return;
- }
- }
- #endif
- }
- }
- }
- #if USE_SND
- /* check for a sampler (snd-edits.c) */
- if (is_sampler(obj))
- {
- gn->vcts[MUS_INPUT_DATA] = (Xen)xen_to_sampler(obj);
- mus_generator_set_feeders(gen, as_needed_input_sampler, as_needed_block_input_sampler);
- return;
- }
- mus_generator_set_feeders(gen, as_needed_input_any, NULL);
- return;
- #endif
- }
- #endif
- mus_generator_set_feeders(gen, as_needed_input_func, NULL);
- }
-
-
- static Xen g_mus_clear_sincs(void)
- {
- mus_clear_sinc_tables();
- return(Xen_false);
- }
-
-
- static Xen g_is_src(Xen obj)
- {
- #define H_is_src "(" S_is_src " gen): " PROC_TRUE " if gen is an " S_src
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_src(Xen_to_mus_any(obj)))));
- }
-
-
- #define SRC_CHANGE_MAX 1000000.0
-
- static Xen g_src(Xen obj, Xen pm, Xen func)
- {
- #define H_src "(" S_src " gen (pm 0.0) input-function): next sampling rate conversion sample. \
- 'pm' can be used to change the sampling rate on a sample-by-sample basis. 'input-function' \
- is a function of one argument (the current input direction, normally ignored) that is called \
- internally whenever a new sample of input data is needed. If the associated " S_make_src " \
- included an 'input' argument, input-function is ignored."
-
- mus_float_t pm1 = 0.0;
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_src, S_src, "an src generator");
- Xen_real_to_C_double_if_bound(pm, pm1, S_src, 2);
-
- /* if sr_change (pm1) is ridiculous, complain! */
- if ((pm1 > SRC_CHANGE_MAX) || (pm1 < -SRC_CHANGE_MAX))
- Xen_out_of_range_error(S_src, 2, pm, "src change too large");
-
- if (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA]))
- {
- if (Xen_is_procedure(func))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else Xen_bad_arity_error(S_src, 3, func, "src input function wants 1 arg");
- }
- }
- return(C_double_to_Xen_real(mus_src(g, pm1, NULL)));
- }
-
- static void set_gn_gen(void *p, mus_any *g)
- {
- mus_xen *gn = (mus_xen *)p;
- gn->gen = g;
- }
-
- static Xen g_make_src(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_src "(" S_make_src " input (srate 1.0) (width 10)): \
- return a new sampling-rate conversion generator (using 'warped sinc interpolation'). \
- 'srate' is the ratio between the new rate and the old. 'width' is the sine \
- width (effectively the steepness of the low-pass filter), normally between 10 and 100. \
- 'input' if given is an open file stream."
-
- Xen in_obj = Xen_undefined;
- mus_xen *gn;
- mus_any *ge = NULL;
- int vals, wid = 0; /* 0 here picks up the current default width in clm.c */
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- mus_float_t srate = 1.0;
-
- keys[0] = kw_input;
- keys[1] = kw_srate;
- keys[2] = kw_width;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6;
-
- vals = mus_optkey_unscramble(S_make_src, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_src, orig_arg[0], Xen_undefined, 1, "src input procedure takes 1 arg");
-
- srate = Xen_optkey_to_float(kw_srate, keys[1], S_make_src, orig_arg[1], srate);
- /* srate can be negative => read in reverse */
-
- wid = Xen_optkey_to_int(kw_width, keys[2], S_make_src, orig_arg[2], wid);
- if (wid < 0)
- Xen_out_of_range_error(S_make_src, orig_arg[2], keys[2], "width < 0?");
- if (wid > 2000)
- Xen_out_of_range_error(S_make_src, orig_arg[2], keys[2], "width > 2000?");
- }
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- /* mus_make_src assumes it can invoke the input function! */
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
-
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_src_with_init(NULL, srate, wid, gn, set_gn_gen);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- Xen src_obj;
- #if HAVE_SCHEME
- int loc;
- #endif
-
- gn->gen = ge;
- src_obj = mus_xen_to_object(gn);
- #if HAVE_SCHEME
- loc = s7_gc_protect(s7, src_obj);
- #endif
- /* src_init can call an input function which can trigger the GC, so we need to GC-protect the new object */
-
- gn->vcts[MUS_SELF_WRAPPER] = src_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- mus_src_init(ge);
- #if HAVE_SCHEME
- s7_gc_unprotect_at(s7, loc);
- #endif
- return(src_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_src));
- }
-
-
-
-
- /* ---------------- granulate ---------------- */
-
- static Xen g_is_granulate(Xen obj)
- {
- #define H_is_granulate "(" S_is_granulate " gen): " PROC_TRUE " if gen is a " S_granulate " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_granulate(Xen_to_mus_any(obj)))));
- }
-
-
- static int grnedit(void *ptr)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(Xen_integer_to_C_int(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
- }
-
-
- static Xen g_granulate(Xen obj, Xen func, Xen edit_func)
- {
- #define H_granulate "(" S_granulate " gen input-func edit-func): next sample from granular synthesis generator"
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_granulate, S_granulate, "a granulate generator");
-
- if ((Xen_is_bound(func)) &&
- (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA])))
- {
- if (Xen_is_procedure(func))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else Xen_bad_arity_error(S_granulate, 2, func, "granulate input function wants 1 arg");
- }
- if (Xen_is_procedure(edit_func))
- {
- if (Xen_is_aritable(edit_func, 1))
- {
- if (!(Xen_is_bound(gn->vcts[MUS_EDIT_FUNCTION]))) /* default value is Xen_undefined */
- {
- mus_granulate_set_edit_function(gn->gen, grnedit);
- gn->vcts[MUS_EDIT_FUNCTION] = edit_func;
- }
- }
- else Xen_bad_arity_error(S_granulate, 3, edit_func, "granulate edit function wants 1 arg");
- }
- }
- return(C_double_to_Xen_real(mus_granulate(g, NULL)));
- }
-
-
- static Xen g_make_granulate(Xen arglist)
- {
- #define H_make_granulate "(" S_make_granulate " input (expansion 1.0) (length .15) (scaler .6) (hop .05) (ramp .4) (jitter 1.0) max-size edit): \
- return a new granular synthesis generator. 'length' is the grain length (seconds), 'expansion' is the ratio in timing \
- between the new and old (expansion > 1.0 slows things down), 'scaler' scales the grains \
- to avoid overflows, 'hop' is the spacing (seconds) between successive grains upon output. \
- 'jitter' controls the randomness in that spacing, 'input' can be a file pointer. 'edit' can \
- be a function of one arg, the current granulate generator. It is called just before \
- a grain is added into the output buffer. The current grain is accessible via " S_mus_data ". \
- The edit function, if any, should return the length in samples of the grain, or 0."
-
- Xen in_obj = Xen_undefined;
- mus_xen *gn;
- mus_any *ge;
- Xen args[18];
- Xen keys[9];
- int orig_arg[9] = {0, 0, 0, 0, 0, 0, 0, 0, 0};
- int vals, maxsize = 0;
- mus_float_t expansion = 1.0, segment_length = .15, segment_scaler = .6, ramp_time = .4, output_hop = .05;
- mus_float_t jitter = 1.0;
- Xen edit_obj = Xen_undefined, grn_obj;
-
- keys[0] = kw_input;
- keys[1] = kw_expansion;
- keys[2] = kw_length;
- keys[3] = kw_scaler;
- keys[4] = kw_hop;
- keys[5] = kw_ramp;
- keys[6] = kw_jitter;
- keys[7] = kw_max_size;
- keys[8] = kw_edit;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 18) clm_error(S_make_granulate, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 18; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_granulate, 9, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_granulate, orig_arg[0], Xen_undefined, 1, "granulate input procedure takes 1 arg");
-
- expansion = Xen_optkey_to_float(kw_expansion, keys[1], S_make_granulate, orig_arg[1], expansion);
- if (expansion <= 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[1], keys[1], "expansion <= 0.0?");
-
- segment_length = Xen_optkey_to_float(kw_length, keys[2], S_make_granulate, orig_arg[2], segment_length);
- if (segment_length <= 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[2], keys[2], "segment-length <= 0.0?");
-
- segment_scaler = Xen_optkey_to_float(kw_scaler, keys[3], S_make_granulate, orig_arg[3], segment_scaler);
- if (segment_scaler == 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[3], keys[3], "segment-scaler should be greater than 0.0?");
-
- output_hop = Xen_optkey_to_float(kw_hop, keys[4], S_make_granulate, orig_arg[4], output_hop);
- if (output_hop <= 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[4], keys[4], "hop <= 0?");
- if (output_hop > 3600.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[4], keys[4], "hop > 3600?");
- if ((segment_length + output_hop) > 60.0) /* multiplied by srate in mus_make_granulate in array allocation */
- Xen_out_of_range_error(S_make_granulate, orig_arg[2], Xen_list_2(keys[2], keys[4]), "segment_length + output_hop too large!");
-
- ramp_time = Xen_optkey_to_float(kw_ramp, keys[5], S_make_granulate, orig_arg[5], ramp_time);
- if ((ramp_time < 0.0) || (ramp_time > 0.5))
- Xen_out_of_range_error(S_make_granulate, orig_arg[5], keys[5], "ramp must be between 0.0 and 0.5");
-
- jitter = Xen_optkey_to_float(kw_jitter, keys[6], S_make_granulate, orig_arg[6], jitter);
- Xen_check_type((jitter >= 0.0) && (jitter < 100.0), keys[6], orig_arg[6], S_make_granulate, "0.0 .. 100.0");
-
- maxsize = Xen_optkey_to_int(kw_max_size, keys[7], S_make_granulate, orig_arg[7], maxsize);
- if ((maxsize > mus_max_malloc()) ||
- (maxsize < 0) ||
- ((maxsize == 0) && (!Xen_is_keyword(keys[7]))))
- Xen_out_of_range_error(S_make_granulate, orig_arg[7], keys[7], "max-size invalid");
-
- edit_obj = mus_optkey_to_procedure(keys[8], S_make_granulate, orig_arg[8], Xen_undefined, 1, "granulate edit procedure takes 1 arg");
- }
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_granulate(NULL,
- expansion, segment_length, segment_scaler, output_hop, ramp_time, jitter, maxsize,
- (!Xen_is_bound(edit_obj) ? NULL : grnedit),
- (void *)gn);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- gn->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_granulate_grain_max_length(ge), mus_data(ge));
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
- gn->vcts[MUS_EDIT_FUNCTION] = edit_obj;
- gn->gen = ge;
- grn_obj = mus_xen_to_object(gn);
- gn->vcts[MUS_SELF_WRAPPER] = grn_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- return(grn_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_granulate));
- }
-
-
-
-
- /* ---------------- convolve ---------------- */
-
- static Xen g_is_convolve(Xen obj)
- {
- #define H_is_convolve "(" S_is_convolve " gen): " PROC_TRUE " if gen is a " S_convolve " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_convolve(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_convolve(Xen obj, Xen func)
- {
- #define H_convolve_gen "(" S_convolve " gen input-func): next sample from convolution generator"
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_convolve, S_convolve, "a convolve generator");
-
- if (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA]))
- {
- if (Xen_is_procedure(func))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else Xen_bad_arity_error(S_convolve, 2, func, "convolve input function wants 1 arg");
- }
- }
- return(C_double_to_Xen_real(mus_convolve(g, NULL)));
- }
-
-
- /* filter-size? */
-
- static Xen g_make_convolve(Xen arglist)
- {
- #define H_make_convolve "(" S_make_convolve " input filter fft-size): \
- return a new convolution generator which convolves its input with the impulse response 'filter'."
-
- mus_xen *gn;
- mus_any *ge;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- vct *filter = NULL;
- Xen filt = Xen_undefined, in_obj = Xen_undefined;
- mus_long_t fftlen, fft_size = 0;
-
- keys[0] = kw_input;
- keys[1] = kw_filter;
- keys[2] = kw_fft_size;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 6) clm_error(S_make_convolve, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 6; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_convolve, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_convolve, orig_arg[0], Xen_undefined, 1, "convolve input procedure takes 1 arg");
-
- filter = mus_optkey_to_vct(keys[1], S_make_convolve, orig_arg[1], NULL);
- if (filter) filt = keys[1];
-
- fft_size = Xen_optkey_to_mus_long_t(kw_fft_size, keys[2], S_make_convolve, orig_arg[2], fft_size);
- if ((fft_size < 0) ||
- ((fft_size == 0) && (!Xen_is_keyword(keys[2]))) ||
- (fft_size > mus_max_malloc()))
- Xen_out_of_range_error(S_make_convolve, orig_arg[2], keys[2], "fft-size invalid (see mus-max-malloc))");
- }
-
- if (filter == NULL)
- Xen_error(NO_DATA,
- Xen_list_1(C_string_to_Xen_string(S_make_convolve ": no impulse (filter)?")));
-
- if (is_power_of_2(mus_vct_length(filter)))
- fftlen = mus_vct_length(filter) * 2;
- else fftlen = (mus_long_t)pow(2.0, 1 + (int)(log((mus_float_t)(mus_vct_length(filter) + 1)) / log(2.0)));
- if (fft_size < fftlen) fft_size = fftlen;
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_convolve(NULL, mus_vct_data(filter), fft_size, mus_vct_length(filter), gn);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- Xen c_obj;
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
- gn->vcts[MUS_ANALYZE_FUNCTION] = filt; /* why is this here? GC protection? (might be a locally-allocated vct as from file->vct) */
- gn->gen = ge;
- c_obj = mus_xen_to_object(gn);
- gn->vcts[MUS_SELF_WRAPPER] = c_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- return(c_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_convolve));
- }
-
-
- static Xen g_convolve_files(Xen file1, Xen file2, Xen maxamp, Xen outfile)
- {
- #define H_convolve_files "(" S_convolve_files " file1 file2 maxamp output-file): convolve \
- file1 and file2 writing outfile after scaling the convolution result to maxamp."
-
- const char *f1, *f2, *f3;
- mus_float_t maxval = 1.0;
-
- Xen_check_type(Xen_is_string(file1), file1, 1, S_convolve_files, "a string");
- Xen_check_type(Xen_is_string(file2), file2, 2, S_convolve_files, "a string");
- Xen_check_type(Xen_is_number_or_unbound(maxamp), maxamp, 3, S_convolve_files, "a number");
- Xen_check_type((!Xen_is_bound(outfile)) || (Xen_is_string(outfile)), outfile, 4, S_convolve_files, "a string");
-
- f1 = Xen_string_to_C_string(file1);
- f2 = Xen_string_to_C_string(file2);
- if (Xen_is_string(outfile))
- f3 = Xen_string_to_C_string(outfile);
- else f3 = "tmp.snd";
- if (Xen_is_number(maxamp))
- maxval = Xen_real_to_C_double(maxamp);
-
- mus_convolve_files(f1, f2, maxval, f3);
- return(C_string_to_Xen_string(f3));
- }
-
-
-
-
- /* ---------------- phase-vocoder ---------------- */
-
- /* pvedit pvanalyze pvsynthesize:
- * these three functions provide a path for the call (clm.c) (*(pv->edit))(pv->closure)
- * which is calling a user-supplied edit function within the particular phase-vocoder
- * generator's context. "closure" is an uninterpreted void pointer passed in by the
- * user, and passed here as the edit function argument. In this file, pv->edit is
- * &pvedit, and (void *)ptr is closure; in make_phase_vocoder we set closure to be
- * the mus_xen object that shadows the phase-vocoder generator, with two special
- * pointers in the vcts field: vcts[MUS_EDIT_FUNCTION] is the (Scheme-side) function
- * passed by the user, and vcts[MUS_SELF_WRAPPER] is a pointer to the (Scheme-relevant)
- * object that packages the mus_xen pointer for Scheme. This way, the user's
- * (make-phase-vocoder ... (lambda (v) (mus-length v)) ...)
- * treats v as the current pv gen, vcts[MUS_SELF_WRAPPER] = v, vcts[MUS_EDIT_FUNCTION] =
- * the lambda form, mus_xen obj->gen is the C-side pv struct pointer. See above
- * under as_needed_input_func for more verbiage. (All this complication arises because clm.c
- * is pure C -- no notion that Scheme might be the caller, and the user's pv.scm
- * or whatever is pure Scheme -- no notion that C is actually doing the work,
- * and we have to tie everything together here including the Scheme-C-Scheme-C
- * call chains).
- */
-
- static int pvedit(void *ptr)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(Xen_boolean_to_C_bool(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
- }
-
-
- static mus_float_t pvsynthesize(void *ptr)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(Xen_real_to_C_double(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_SYNTHESIZE_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
- }
-
-
- static bool pvanalyze(void *ptr, mus_float_t (*input)(void *arg1, int direction))
- {
- mus_xen *gn = (mus_xen *)ptr;
- /* we can only get input func if it's already set up by the outer gen call, so (?) we can use that function here.
- * but the gc might be called during this call, and scan the args, so the input function should be
- * in the arg list only if its a legit pointer?
- */
- return(Xen_boolean_to_C_bool(Xen_unprotected_call_with_2_args(gn->vcts[MUS_ANALYZE_FUNCTION],
- gn->vcts[MUS_SELF_WRAPPER],
- gn->vcts[MUS_INPUT_FUNCTION])));
- }
-
-
- static Xen g_is_phase_vocoder(Xen obj)
- {
- #define H_is_phase_vocoder "(" S_is_phase_vocoder " gen): " PROC_TRUE " if gen is an " S_phase_vocoder
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_phase_vocoder(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_phase_vocoder(Xen obj, Xen func, Xen analyze_func, Xen edit_func, Xen synthesize_func)
- {
- #define H_phase_vocoder "(" S_phase_vocoder " gen input-function analyze-func edit-func synthesize-func): next phase vocoder value"
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_phase_vocoder, S_phase_vocoder, "a phase-vocoder generator");
-
- if (Xen_is_bound(func))
- {
- bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)) = NULL;
- int (*edit)(void *arg) = NULL;
- mus_float_t (*synthesize)(void *arg) = NULL;
-
- if ((Xen_is_procedure(func)) &&
- (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA])))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func; /* as_needed_input_func set at make time will pick this up */
- else Xen_bad_arity_error(S_phase_vocoder, 2, func, S_phase_vocoder " input function wants 1 arg");
- }
- if (Xen_is_procedure(analyze_func))
- {
- if (Xen_is_aritable(analyze_func, 2))
- {
- gn->vcts[MUS_ANALYZE_FUNCTION] = analyze_func;
- analyze = pvanalyze;
- }
- else Xen_bad_arity_error(S_phase_vocoder, 3, analyze_func, S_phase_vocoder " analyze function wants 2 args");
- }
- if (Xen_is_procedure(edit_func))
- {
- if (Xen_is_aritable(edit_func, 1))
- {
- gn->vcts[MUS_EDIT_FUNCTION] = edit_func;
- edit = pvedit;
- }
- else Xen_bad_arity_error(S_phase_vocoder, 4, edit_func, S_phase_vocoder " edit function wants 1 arg");
- }
- if (Xen_is_procedure(synthesize_func))
- {
- if (Xen_is_aritable(synthesize_func, 1))
- {
- gn->vcts[MUS_SYNTHESIZE_FUNCTION] = synthesize_func;
- synthesize = pvsynthesize;
- }
- else Xen_bad_arity_error(S_phase_vocoder, 5, synthesize_func, S_phase_vocoder " synthesize function wants 1 arg");
- }
- return(C_double_to_Xen_real(mus_phase_vocoder_with_editors(g, NULL, analyze, edit, synthesize)));
- }
- return(C_double_to_Xen_real(mus_phase_vocoder(g, NULL)));
- }
-
-
- static Xen g_make_phase_vocoder(Xen arglist)
- {
- #if HAVE_SCHEME
- #define pv_example "(" S_make_phase_vocoder " #f 512 4 256 1.0 #f #f #f)"
- #define pv_edit_example "(" S_make_phase_vocoder " #f 512 4 256 1.0\n\
- (lambda (v infunc) (snd-print \"analyzing\") #t)\n\
- (lambda (v) (snd-print \"editing\") #t)\n\
- (lambda (v) (snd-print \"resynthesizing\") 0.0))"
- #endif
- #if HAVE_RUBY
- #define pv_example "make_phase_vocoder(false, 512, 4, 256, 1.0, false, false, false)"
- #define pv_edit_example "make_phase_vocoder(false, 512, 4, 256, 1.0,\n\
- lambda do | v, infunc | snd_print(\"analyzing\"); true end,\n\
- lambda do | v | snd_print(\"editing\"); true end,\n\
- lambda do | v | snd_print(\"resynthesizing\"); 0.0 end)"
- #endif
- #if HAVE_FORTH
- #define pv_example "#f 512 4 256 1.0 #f #f #f " S_make_phase_vocoder
- #define pv_edit_example "#f 512 4 256 1.0\n\
- lambda: <{ v infunc -- f }> \"analyzing\" snd-print drop #t ;\n\
- lambda: <{ v -- n }> \"editing\" snd-print drop #t ;\n\
- lambda: <{ v -- r }> \"resynthesizing\" snd-print drop 0.0 ; " S_make_phase_vocoder
- #endif
-
- #define H_make_phase_vocoder "(" S_make_phase_vocoder " input fft-size overlap interp pitch analyze edit synthesize): \
- return a new phase-vocoder generator; input is the input function (it can be set at run-time), analyze, edit, \
- and synthesize are either " PROC_FALSE " or functions that replace the default innards of the generator, fft-size, overlap \
- and interp set the fftsize, the amount of overlap between ffts, and the time between new analysis calls. \
- 'analyze', if given, takes 2 args, the generator and the input function; if it returns " PROC_TRUE ", the default analysis \
- code is also called. 'edit', if given, takes 1 arg, the generator; if it returns " PROC_TRUE ", the default edit code \
- is run. 'synthesize' is a function of 1 arg, the generator; it is called to get the current vocoder \
- output. \n\n " pv_example "\n\n " pv_edit_example
-
- Xen in_obj = Xen_undefined, edit_obj = Xen_undefined, synthesize_obj = Xen_undefined, analyze_obj = Xen_undefined;
- mus_xen *gn;
- mus_any *ge;
- Xen args[16];
- Xen keys[8];
- Xen pv_obj;
- int orig_arg[8] = {0, 0, 0, 0, 0, 0, 0, 0};
- int vals;
- int fft_size = 512, overlap = 4, interp = 128;
- mus_float_t pitch = 1.0;
-
- keys[0] = kw_input;
- keys[1] = kw_fft_size;
- keys[2] = kw_overlap;
- keys[3] = kw_interp;
- keys[4] = kw_pitch;
- keys[5] = kw_analyze;
- keys[6] = kw_edit;
- keys[7] = kw_synthesize;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 16) clm_error(S_make_phase_vocoder, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 16; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_phase_vocoder, 8, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_phase_vocoder, orig_arg[0], Xen_undefined, 1, S_phase_vocoder " input procedure takes 1 arg");
-
- fft_size = Xen_optkey_to_int(kw_fft_size, keys[1], S_make_phase_vocoder, orig_arg[1], fft_size);
- if (fft_size <= 1)
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size <= 1?");
- if (fft_size > mus_max_malloc())
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size too large (see mus-max-malloc)");
- if (!is_power_of_2(fft_size))
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size must be power of 2");
-
- overlap = Xen_optkey_to_int(kw_overlap, keys[2], S_make_phase_vocoder, orig_arg[2], overlap);
- if (overlap <= 0)
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[2], keys[2], "overlap <= 0?");
-
- interp = Xen_optkey_to_int(kw_interp, keys[3], S_make_phase_vocoder, orig_arg[3], interp);
- if (interp <= 0)
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[3], keys[3], "interp <= 0?");
-
- pitch = Xen_optkey_to_float(kw_pitch, keys[4], S_make_phase_vocoder, orig_arg[4], pitch);
-
- analyze_obj = mus_optkey_to_procedure(keys[5], S_make_phase_vocoder, orig_arg[5], Xen_undefined, 2, S_phase_vocoder " analyze procedure takes 2 args");
- edit_obj = mus_optkey_to_procedure(keys[6], S_make_phase_vocoder, orig_arg[6], Xen_undefined, 1, S_phase_vocoder " edit procedure takes 1 arg");
- synthesize_obj = mus_optkey_to_procedure(keys[7], S_make_phase_vocoder, orig_arg[7], Xen_undefined, 1, S_phase_vocoder " synthesize procedure takes 1 arg");
- }
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_phase_vocoder(NULL,
- fft_size, overlap, interp, pitch,
- (!Xen_is_bound(analyze_obj) ? NULL : pvanalyze),
- (!Xen_is_bound(edit_obj) ? NULL : pvedit),
- (!Xen_is_bound(synthesize_obj) ? NULL : pvsynthesize),
- (void *)gn);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
- gn->vcts[MUS_EDIT_FUNCTION] = edit_obj;
- gn->vcts[MUS_ANALYZE_FUNCTION] = analyze_obj;
- gn->vcts[MUS_SYNTHESIZE_FUNCTION] = synthesize_obj;
- gn->gen = ge;
- pv_obj = mus_xen_to_object(gn);
- /* need scheme-relative backpointer for possible function calls */
- gn->vcts[MUS_SELF_WRAPPER] = pv_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- return(pv_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_phase_vocoder));
- }
-
-
- static Xen g_phase_vocoder_amps(Xen pv)
- {
- #define H_phase_vocoder_amps "(" S_phase_vocoder_amps " gen): " S_vct " containing the current output sinusoid amplitudes"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_amps, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_amps(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len / 2, amps));
- }
-
-
- static Xen g_phase_vocoder_freqs(Xen pv)
- {
- #define H_phase_vocoder_freqs "(" S_phase_vocoder_freqs " gen): " S_vct " containing the current output sinusoid frequencies"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_freqs, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_freqs(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len, amps));
- }
-
-
- static Xen g_phase_vocoder_phases(Xen pv)
- {
- #define H_phase_vocoder_phases "(" S_phase_vocoder_phases " gen): " S_vct " containing the current output sinusoid phases"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_phases, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_phases(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len / 2, amps));
- }
-
-
- static Xen g_phase_vocoder_amp_increments(Xen pv)
- {
- #define H_phase_vocoder_amp_increments "(" S_phase_vocoder_amp_increments " gen): " S_vct " containing the current output sinusoid amplitude increments per sample"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_amp_increments, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_amp_increments(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len, amps));
- }
-
-
- static Xen g_phase_vocoder_phase_increments(Xen pv)
- {
- #define H_phase_vocoder_phase_increments "(" S_phase_vocoder_phase_increments " gen): " S_vct " containing the current output sinusoid phase increments"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_phase_increments, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_phase_increments(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len / 2, amps));
- }
-
-
-
-
- /* -------- ssb-am -------- */
-
- static Xen g_is_ssb_am(Xen obj)
- {
- #define H_is_ssb_am "(" S_is_ssb_am " gen): " PROC_TRUE " if gen is a " S_ssb_am
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_ssb_am(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_ssb_am(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_ssb_am "(" S_make_ssb_am " (frequency *clm-default-frequency*) (order 40)): \
- return a new " S_ssb_am " generator."
- #define MUS_MAX_SSB_ORDER 65536
-
- mus_any *ge;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals;
- int order = 40;
- mus_float_t freq;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_order;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(S_make_ssb_am, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_ssb_am, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_ssb_am, orig_arg[0], keys[0], "freq > srate/2?");
-
- order = Xen_optkey_to_int(kw_order, keys[1], S_make_ssb_am, orig_arg[1], order);
- if (order <= 0)
- Xen_out_of_range_error(S_make_ssb_am, orig_arg[1], keys[1], "order <= 0?");
- if (order > MUS_MAX_SSB_ORDER)
- Xen_out_of_range_error(S_make_ssb_am, orig_arg[1], keys[1], "order too large?");
- }
-
- ge = mus_make_ssb_am(freq, order);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_ssb_am(Xen obj, Xen insig, Xen fm)
- {
- #define H_ssb_am "(" S_ssb_am " gen (insig 0.0) (fm 0.0)): get the next sample from " S_ssb_am " generator"
-
- mus_float_t insig1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_ssb_am, S_ssb_am, "an ssb-am generator");
- Xen_real_to_C_double_if_bound(insig, insig1, S_ssb_am, 2);
-
- if (Xen_is_bound(fm))
- {
- Xen_check_type(Xen_is_number(fm), fm, 3, S_ssb_am, "a number");
- return(C_double_to_Xen_real(mus_ssb_am(g, insig1, Xen_real_to_C_double(fm))));
- }
- return(C_double_to_Xen_real(mus_ssb_am_unmodulated(g, insig1)));
- }
-
-
- #define S_mus_frandom "mus-frandom"
- #define S_mus_irandom "mus-irandom"
-
- static Xen g_mus_frandom(Xen val)
- {
- return(C_double_to_Xen_real(mus_frandom(Xen_real_to_C_double_with_caller(val, S_mus_frandom))));
- }
-
- static Xen g_mus_irandom(Xen val)
- {
- mus_long_t ind;
- Xen_to_C_integer_or_error(val, ind, S_mus_irandom, 1);
- return(C_int_to_Xen_integer(mus_irandom(ind)));
- }
-
-
- static Xen mus_clm_output(void);
- static Xen mus_clm_reverb(void);
-
-
-
- /* Xen out, Xen in, Xen ost, Xen olen, Xen ist, Xen mx, Xen envs */
- static Xen g_mus_file_mix(Xen args)
- {
- #define H_mus_file_mix "(" S_mus_file_mix " outfile infile (outloc 0) (framples) (inloc 0) matrix envs): \
- mix infile into outfile starting at outloc in outfile and inloc in infile \
- mixing 'framples' framples into 'outfile'. framples defaults to the length of infile. If matrix, \
- use it to scale the various channels; if envs (an array of envelope generators), use \
- it in conjunction with matrix to scale/envelope all the various ins and outs. \
- 'outfile' can also be a " S_frample_to_file " generator, and 'infile' can be a " S_file_to_frample " generator."
-
- Xen arg, out, in;
- mus_any *outf = NULL, *inf = NULL;
- mus_float_t *matrix = NULL;
- mus_any ***envs1 = NULL;
- int i;
- mus_long_t ostart = 0, istart = 0, osamps = 0;
- int in_chans = 0, out_chans = 0, mx_chans = 0, in_size = 0; /* mus_mix in clm.c assumes the envs array is large enough */
- const char *outfile = NULL, *infile = NULL;
-
- /* -------- setup output gen -------- */
- arg = args;
- out = Xen_car(arg);
- Xen_check_type(Xen_is_string(out) || ((mus_is_xen(out)) && (mus_is_output(Xen_to_mus_any(out)))),
- out, 1, S_mus_file_mix, "a filename or a " S_frample_to_file " generator");
- if (Xen_is_string(out))
- {
- outfile = Xen_string_to_C_string(out);
- if (!mus_file_probe(outfile))
- Xen_error(NO_SUCH_FILE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": no such file, ~S"), out));
- out_chans = mus_sound_chans(outfile);
- if (out_chans <= 0)
- Xen_error(BAD_HEADER, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": ~S output chans <= 0"), out));
- }
- else
- {
- outf = Xen_to_mus_any(out);
- out_chans = mus_channels(outf);
- }
-
- /* -------- setup input gen -------- */
- arg = Xen_cdr(arg);
- in = Xen_car(arg);
- Xen_check_type(Xen_is_string(in) || ((mus_is_xen(in)) && (mus_is_input(Xen_to_mus_any(in)))),
- in, 2, S_mus_file_mix, "a filename or a " S_file_to_frample " generator");
- if (Xen_is_string(in))
- {
- infile = Xen_string_to_C_string(in);
- if (!mus_file_probe(infile))
- Xen_error(NO_SUCH_FILE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": no such file, ~S"), in));
- in_chans = mus_sound_chans(infile);
- if (in_chans <= 0)
- Xen_error(BAD_HEADER, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": ~S input chans <= 0"), in));
- osamps = mus_sound_framples(infile);
- }
- else
- {
- inf = Xen_to_mus_any(in);
- in_chans = mus_channels(inf);
- osamps = mus_length(inf);
- }
-
- /* inf and outf only exist during the rest of the arglist scan if not infile or outfile.
- * we need to delay making the inf/outf gens in this case to greatly simplify error handling.
- */
-
- /* rest of args are optional */
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen ost;
- ost = Xen_car(arg);
- Xen_check_type(Xen_is_integer(ost), ost, 3, S_mus_file_mix, "an integer");
- ostart = Xen_llong_to_C_llong(ost);
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen olen;
- olen = Xen_car(arg);
- Xen_check_type(Xen_is_integer(olen), olen, 4, S_mus_file_mix, "an integer");
- osamps = Xen_llong_to_C_llong(olen);
- if (osamps <= 0) return(Xen_false);
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen ist;
- ist = Xen_car(arg);
- Xen_check_type(Xen_is_integer(ist), ist, 5, S_mus_file_mix, "an integer");
- istart = Xen_llong_to_C_llong(ist);
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen mx;
- mx = Xen_car(arg);
- Xen_check_type((mus_is_vct(mx)) || (Xen_is_false(mx)), mx, 6, S_mus_file_mix, "a " S_vct);
- if (mus_is_vct(mx))
- {
- matrix = mus_vct_data(Xen_to_vct(mx));
- mx_chans = (int)sqrt(mus_vct_length(Xen_to_vct(mx)));
- }
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen envs;
- envs = Xen_car(arg);
- Xen_check_type((Xen_is_false(envs)) || (Xen_is_vector(envs)), envs, 7, S_mus_file_mix, "a vector of envs");
- if (Xen_is_vector(envs))
- {
- int in_len = 0, out_len, j, out_size;
- /* pack into a C-style array of arrays of env pointers */
- in_len = Xen_vector_length(envs);
- if (in_len == 0)
- Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": env vector, ~A, can't be empty"), envs));
-
- for (i = 0; i < in_len; i++)
- {
- Xen datum;
- datum = Xen_vector_ref(envs, i);
- if (!(Xen_is_vector(datum)))
- Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": vector, ~A, must contain vectors of envelopes"), datum));
- }
-
- out_len = Xen_vector_length(Xen_vector_ref(envs, 0));
- if (in_len < in_chans) in_size = in_chans; else in_size = in_len;
- if (out_len < out_chans) out_size = out_chans; else out_size = out_len;
-
- envs1 = (mus_any ***)malloc(in_size * sizeof(mus_any **));
- for (i = 0; i < in_size; i++)
- envs1[i] = (mus_any **)calloc(out_size, sizeof(mus_any *));
-
- for (i = 0; i < in_len; i++)
- for (j = 0; j < out_len; j++)
- {
- Xen datum1;
- datum1 = Xen_vector_ref(Xen_vector_ref(envs, i), j);
- if (mus_is_xen(datum1))
- {
- if (mus_is_env(Xen_to_mus_any(datum1)))
- envs1[i][j] = Xen_to_mus_any(datum1);
- else
- {
- for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
- free(envs1);
- Xen_error(BAD_TYPE, Xen_list_4(C_string_to_Xen_string(S_mus_file_mix ": vector, ~A at ~A ~A, must contain an envelope"),
- datum1,
- C_int_to_Xen_integer(i),
- C_int_to_Xen_integer(j)));
- }
- }
- }
- }
- }
- }
- }
- }
- }
-
- if ((infile) && (outfile))
- mus_file_mix(outfile, infile, ostart, osamps, istart, matrix, mx_chans, envs1);
- else
- {
- if (infile)
- inf = mus_make_file_to_frample(infile);
- if (outfile)
- outf = mus_continue_sample_to_file(outfile);
- mus_file_mix_with_reader_and_writer(outf, inf, ostart, osamps, istart, matrix, mx_chans, envs1);
- if (infile)
- mus_free((mus_any *)inf);
- if (outfile)
- mus_free((mus_any *)outf);
- }
- if (envs1)
- {
- for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
- free(envs1);
- }
- return(Xen_true);
- }
-
-
- /* Xen file, Xen beg, Xen dur, Xen mx, Xen revmx, Xen envs, Xen srcs, Xen srcenv, Xen outstream, Xen revstream */
-
- static Xen g_mus_file_mix_with_envs(Xen args)
- {
- #define H_mus_file_mix_with_envs "(" S_mus_file_mix_with_envs " file beg dur mx revmx envs srcs srcenv out rev) is an extension of " S_mus_file_mix ", primarily \
- intended to speed up the fullmix instrument. file is a vector of readin generators. beg is the sample at which to start mixing \
- output, dur is the number of samples to write. mx is a matrix, revmx is either #f or a matrix. "
-
- int i, in_chans, out_chans, mx_chans = 0, rev_chans = 0, rev_mix_chans = 0;
- mus_long_t st, nd;
- mus_any *s_env = NULL, *ostr, *rstr = NULL;
- mus_any **mix_envs, **mix_srcs, **mix_rds;
- mus_xen *gn;
- Xen ve, arg, file, beg, dur, mx, revmx, envs, srcs, srcenv, outstream, revstream;
- mus_float_t *mix = NULL, *rev_mix = NULL;
-
- i = Xen_list_length(args);
- if ((i < 8) || (i > 10)) /* no wrong-number-of-args error in xen.h, so I'll use out-of-range */
- Xen_out_of_range_error(S_mus_file_mix_with_envs, 0, args, "wrong number of args");
-
- arg = args;
- file = Xen_car(arg);
- Xen_check_type(Xen_is_vector(file), file, 1, S_mus_file_mix_with_envs, "a vector of readin generators");
- in_chans = Xen_vector_length(file);
-
- arg = Xen_cdr(arg);
- beg = Xen_car(arg);
- Xen_check_type(Xen_is_integer(beg), beg, 2, S_mus_file_mix_with_envs, "an integer");
- st = Xen_integer_to_C_int(beg);
-
- arg = Xen_cdr(arg);
- dur = Xen_car(arg);
- Xen_check_type(Xen_is_integer(dur), dur, 3, S_mus_file_mix_with_envs, "an integer");
- nd = st + Xen_integer_to_C_int(dur);
-
- arg = Xen_cdr(arg);
- mx = Xen_car(arg);
- if (mus_is_vct(mx))
- {
- mix = mus_vct_data(Xen_to_vct(mx));
- mx_chans = (int)sqrt(mus_vct_length(Xen_to_vct(mx)));
- }
-
- arg = Xen_cdr(arg);
- revmx = Xen_car(arg);
- if (mus_is_vct(revmx))
- {
- rev_mix = mus_vct_data(Xen_to_vct(revmx));
- rev_mix_chans = (int)sqrt(mus_vct_length(Xen_to_vct(revmx)));
- }
-
- arg = Xen_cdr(arg);
- envs = Xen_car(arg);
- if (!Xen_is_false(envs))
- Xen_check_type(Xen_is_vector(envs), envs, 6, S_mus_file_mix_with_envs, "a vector of env generators");
-
- arg = Xen_cdr(arg);
- srcs = Xen_car(arg);
- if (!Xen_is_false(srcs))
- Xen_check_type(Xen_is_vector(srcs), srcs, 7, S_mus_file_mix_with_envs, "a vector of src generators");
-
- arg = Xen_cdr(arg);
- srcenv = Xen_car(arg);
- if (!Xen_is_false(srcenv))
- {
- gn = (mus_xen *)Xen_object_ref_checked(srcenv, mus_xen_tag);
- if (!gn) Xen_check_type(false, srcenv, 8, S_mus_file_mix_with_envs, "an env generator");
- s_env = gn->gen;
- Xen_check_type(mus_is_env(s_env), srcenv, 8, S_mus_file_mix_with_envs, "an env generator");
- }
-
- revstream = Xen_false;
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- outstream = Xen_car(arg);
- gn = (mus_xen *)Xen_object_ref_checked(outstream, mus_xen_tag);
- if (!gn)
- Xen_check_type(false, outstream, 9, S_mus_file_mix_with_envs, "an output generator");
- ostr = gn->gen;
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- revstream = Xen_car(arg);
- }
- else ostr = Xen_to_mus_any(mus_clm_output());
- out_chans = mus_channels(ostr);
-
- if (rev_mix)
- {
- if (!Xen_is_false(revstream))
- {
- gn = (mus_xen *)Xen_object_ref_checked(revstream, mus_xen_tag);
- if (!gn)
- Xen_check_type(false, revstream, 10, S_mus_file_mix_with_envs, "an output generator");
- rstr = gn->gen;
- }
- else rstr = Xen_to_mus_any(mus_clm_reverb());
- rev_chans = mus_channels(rstr);
- }
-
- mix_rds = (mus_any **)calloc(in_chans, sizeof(mus_any *));
- mix_srcs = (mus_any **)calloc(in_chans, sizeof(mus_any *));
-
- for (i = 0; i < in_chans; i++)
- mix_rds[i] = Xen_to_mus_any(Xen_vector_ref(file, i));
-
- if (Xen_is_vector(srcs))
- {
- for (i = 0; i < in_chans; i++)
- {
- ve = Xen_vector_ref(srcs, i);
- if (!Xen_is_false(ve)) mix_srcs[i] = Xen_to_mus_any(ve);
- }
- }
-
- mix_envs = (mus_any **)calloc(in_chans * out_chans, sizeof(mus_any *));
- if (Xen_is_vector(envs))
- for (i = 0; i < in_chans * out_chans; i++)
- {
- ve = Xen_vector_ref(envs, i);
- if (!Xen_is_false(ve)) mix_envs[i] = Xen_to_mus_any(ve);
- }
-
- {
- mus_long_t samp;
- int outp;
- mus_float_t src_env_val = 0.0;
- mus_float_t *infs, *out_frample, *rev_frample = NULL;
-
- infs = (mus_float_t *)calloc(in_chans, sizeof(mus_float_t));
- out_frample = (mus_float_t *)calloc(out_chans, sizeof(mus_float_t));
- if (rev_mix) rev_frample = (mus_float_t *)calloc(rev_chans, sizeof(mus_float_t));
-
- if (in_chans == 1)
- {
- mus_any *s = NULL, *r = NULL;
- s = mix_srcs[0];
- if (!s) r = mix_rds[0];
-
- for (samp = st; samp < nd; samp++)
- {
- for (outp = 0; outp < out_chans; outp++)
- {
- mus_any *e;
- e = mix_envs[outp];
- if (e)
- mix[outp] = mus_env(e);
- }
- if (s_env)
- src_env_val = mus_env(s_env);
- if (s)
- infs[0] = mus_src(s, src_env_val, NULL);
- else
- {
- if (r)
- infs[0] = mus_readin(r);
- else infs[0] = 0.0;
- }
- mus_frample_to_file(ostr, samp, mus_frample_to_frample(mix, mx_chans, infs, in_chans, out_frample, out_chans));
- if (rev_mix) mus_frample_to_file(rstr, samp, mus_frample_to_frample(rev_mix, rev_mix_chans, infs, in_chans, rev_frample, rev_chans));
- }
- }
- else
- {
- for (samp = st; samp < nd; samp++)
- {
- int inp, off;
- for (inp = 0, off = 0; inp < in_chans; inp++, off += mx_chans)
- for (outp = 0; outp < out_chans; outp++)
- {
- mus_any *e;
- e = mix_envs[inp * out_chans + outp]; /* this is different from the matrix setup -- I don't know why */
- if (e)
- mix[off + outp] = mus_env(e);
- }
- if (s_env)
- src_env_val = mus_env(s_env);
- for (inp = 0; inp < in_chans; inp++)
- {
- mus_any *s;
- s = mix_srcs[inp];
- if (s)
- infs[inp] = mus_src(s, src_env_val, NULL);
- else
- {
- s = mix_rds[inp];
- if (s)
- infs[inp] = mus_readin(s);
- else infs[inp] = 0.0;
- }
- }
- mus_frample_to_file(ostr, samp, mus_frample_to_frample(mix, mx_chans, infs, in_chans, out_frample, out_chans));
- if (rev_mix) mus_frample_to_file(rstr, samp, mus_frample_to_frample(rev_mix, rev_mix_chans, infs, in_chans, rev_frample, rev_chans));
- }
- }
- free(infs);
- free(out_frample);
- if (rev_frample) free(rev_frample);
- }
-
- free(mix_rds);
- free(mix_srcs);
- free(mix_envs);
- return(Xen_false);
- }
-
-
- static Xen g_frample_to_frample(Xen mx, Xen infr, Xen inchans, Xen outfr, Xen outchans)
- {
- #define H_frample_to_frample "(" S_frample_to_frample " matrix in-data in-chans out-data out-chans): pass frample in-data through matrix \
- returning frample out-data; this is a matrix multiply of matrix and in-data"
- int ins, outs, mxs;
- vct *vin, *vout, *vmx;
-
- Xen_check_type(mus_is_vct(mx), mx, 1, S_frample_to_frample, "a " S_vct);
- Xen_check_type(mus_is_vct(infr), infr, 2, S_frample_to_frample, "a " S_vct);
- Xen_check_type(mus_is_vct(outfr), outfr, 4, S_frample_to_frample, "a " S_vct);
- Xen_check_type(Xen_is_integer(inchans), inchans, 3, S_frample_to_frample, "an integer");
- Xen_check_type(Xen_is_integer(outchans), outchans, 5, S_frample_to_frample, "an integer");
-
- ins = Xen_integer_to_C_int(inchans);
- vin = Xen_to_vct(infr);
- if (mus_vct_length(vin) < ins) ins = mus_vct_length(vin);
- if (ins <= 0) return(outfr);
-
- outs = Xen_integer_to_C_int(outchans);
- vout = Xen_to_vct(outfr);
- if (mus_vct_length(vout) < outs) outs = mus_vct_length(vout);
- if (outs <= 0) return(outfr);
-
- vmx = Xen_to_vct(mx);
- mxs = (int)sqrt(mus_vct_length(vmx));
-
- mus_frample_to_frample(mus_vct_data(vmx), mxs, mus_vct_data(vin), ins, mus_vct_data(vout), outs);
- return(outfr);
- }
-
-
-
-
- #if HAVE_SCHEME
- #ifndef _MSC_VER
-
- #include <time.h>
- #include <sys/time.h>
-
- static struct timeval overall_start_time;
- #define S_get_internal_real_time "get-internal-real-time"
- #define S_internal_time_units_per_second "internal-time-units-per-second"
-
- static Xen g_get_internal_real_time(void)
- {
- #define H_get_internal_real_time "(" S_get_internal_real_time ") returns the number of seconds since \
- the program started. The number is in terms of " S_internal_time_units_per_second ", usually 1"
- struct timezone z0;
- struct timeval t0;
- mus_float_t secs;
- gettimeofday(&t0, &z0);
- secs = difftime(t0.tv_sec, overall_start_time.tv_sec);
- return(C_double_to_Xen_real(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)));
- }
- #else
- static Xen g_get_internal_real_time(void) {return(C_double_to_Xen_real(0.0));}
- #endif
-
- Xen_wrap_no_args(g_get_internal_real_time_w, g_get_internal_real_time)
- #endif
-
-
-
-
- /* -------------------------------- scheme-side optimization -------------------------------- */
-
- #if HAVE_SCHEME
- #if (!WITH_GMP)
- #define car(E) s7_car(E)
- #define cdr(E) s7_cdr(E)
- #define cadr(E) s7_cadr(E)
- #define caddr(E) s7_caddr(E)
- #define cadddr(E) s7_cadddr(E)
- #define cadddr(E) s7_cadddr(E)
-
- static mus_float_t mus_nsin_unmodulated(mus_any *p) {return(mus_nsin(p, 0.0));}
- static mus_float_t mus_ncos_unmodulated(mus_any *p) {return(mus_ncos(p, 0.0));}
- static mus_float_t mus_nrxysin_unmodulated(mus_any *p) {return(mus_nrxysin(p, 0.0));}
- static mus_float_t mus_nrxycos_unmodulated(mus_any *p) {return(mus_nrxycos(p, 0.0));}
- static mus_float_t mus_rxyksin_unmodulated(mus_any *p) {return(mus_rxyksin(p, 0.0));}
- static mus_float_t mus_rxykcos_unmodulated(mus_any *p) {return(mus_rxykcos(p, 0.0));}
- static mus_float_t mus_square_wave_unmodulated(mus_any *p) {return(mus_square_wave(p, 0.0));}
- static mus_float_t mus_sawtooth_wave_unmodulated(mus_any *p) {return(mus_sawtooth_wave(p, 0.0));}
-
- static mus_float_t mus_src_simple(mus_any *p) {return(mus_src(p, 0.0, NULL));}
- static mus_float_t mus_src_two(mus_any *p, mus_float_t x) {return(mus_src(p, x, NULL));}
- static mus_float_t mus_granulate_simple(mus_any *p) {return(mus_granulate_with_editor(p, NULL, NULL));}
- static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL));}
- static mus_float_t mus_phase_vocoder_simple(mus_any *p) {return(mus_phase_vocoder(p, NULL));}
-
- #define mus_oscil_rf mus_oscil_unmodulated
- #define mus_polywave_rf mus_polywave_unmodulated
- #define mus_ncos_rf mus_ncos_unmodulated
- #define mus_nsin_rf mus_nsin_unmodulated
- #define mus_nrxycos_rf mus_nrxycos_unmodulated
- #define mus_nrxysin_rf mus_nrxysin_unmodulated
- #define mus_rxykcos_rf mus_rxykcos_unmodulated
- #define mus_rxyksin_rf mus_rxyksin_unmodulated
- #define mus_rand_rf mus_rand_unmodulated
- #define mus_rand_interp_rf mus_rand_interp_unmodulated
- #define mus_readin_rf mus_readin
- #define mus_env_rf mus_env
- #define mus_pulsed_env_rf mus_pulsed_env_unmodulated
- #define mus_oscil_bank_rf mus_oscil_bank
- #define mus_table_lookup_rf mus_table_lookup_unmodulated
- #define mus_sawtooth_wave_rf mus_sawtooth_wave_unmodulated
- #define mus_pulse_train_rf mus_pulse_train_unmodulated
- #define mus_triangle_wave_rf mus_triangle_wave_unmodulated
- #define mus_square_wave_rf mus_square_wave_unmodulated
- #define mus_wave_train_rf mus_wave_train_unmodulated
-
- #define mus_convolve_rf mus_convolve_simple
- #define mus_src_rf mus_src_simple
- #define mus_granulate_rf mus_granulate_simple
- #define mus_phase_vocoder_rf mus_phase_vocoder_simple
-
- static mus_float_t mus_one_pole_rf(mus_any *p) {return(mus_one_pole(p, 0.0));}
- static mus_float_t mus_two_pole_rf(mus_any *p) {return(mus_two_pole(p, 0.0));}
- static mus_float_t mus_one_zero_rf(mus_any *p) {return(mus_one_zero(p, 0.0));}
- static mus_float_t mus_two_zero_rf(mus_any *p) {return(mus_two_zero(p, 0.0));}
- static mus_float_t mus_delay_rf(mus_any *p) {return(mus_delay_unmodulated(p, 0.0));}
- static mus_float_t mus_comb_rf(mus_any *p) {return(mus_comb_unmodulated(p, 0.0));}
- static mus_float_t mus_comb_bank_rf(mus_any *p) {return(mus_comb_bank(p, 0.0));}
- static mus_float_t mus_all_pass_bank_rf(mus_any *p) {return(mus_all_pass_bank(p, 0.0));}
- static mus_float_t mus_notch_rf(mus_any *p) {return(mus_notch_unmodulated(p, 0.0));}
- static mus_float_t mus_all_pass_rf(mus_any *p) {return(mus_all_pass_unmodulated(p, 0.0));}
- static mus_float_t mus_one_pole_all_pass_rf(mus_any *p) {return(mus_one_pole_all_pass(p, 0.0));}
- static mus_float_t mus_moving_average_rf(mus_any *p) {return(mus_moving_average(p, 0.0));}
- static mus_float_t mus_moving_max_rf(mus_any *p) {return(mus_moving_max(p, 0.0));}
- static mus_float_t mus_moving_norm_rf(mus_any *p) {return(mus_moving_norm(p, 0.0));}
- static mus_float_t mus_filter_rf(mus_any *p) {return(mus_filter(p, 0.0));}
- static mus_float_t mus_fir_filter_rf(mus_any *p) {return(mus_fir_filter(p, 0.0));}
- static mus_float_t mus_iir_filter_rf(mus_any *p) {return(mus_iir_filter(p, 0.0));}
- static mus_float_t mus_polyshape_rf(mus_any *p) {return(mus_polyshape_unmodulated(p, 1.0));}
- static mus_float_t mus_filtered_comb_rf(mus_any *p) {return(mus_filtered_comb_unmodulated(p, 0.0));}
- static mus_float_t mus_filtered_comb_bank_rf(mus_any *p) {return(mus_filtered_comb_bank(p, 0.0));}
- static mus_float_t mus_asymmetric_fm_rf(mus_any *p) {return(mus_asymmetric_fm_unmodulated(p, 0.0));}
- static mus_float_t mus_formant_rf(mus_any *p) {return(mus_formant(p, 0.0));}
- static mus_float_t mus_firmant_rf(mus_any *p) {return(mus_firmant(p, 0.0));}
-
- static mus_float_t mus_ssb_am_rf_1(mus_any *p) {return(mus_ssb_am(p, 0.0, 0.0));}
-
- static mus_any *cadr_gen(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer sym, o;
- mus_xen *gn;
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- if (s7_xf_is_stepper(sc, sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- return(gn->gen);
- }
-
- static s7_rf_t caddr_rf(s7_scheme *sc, s7_pointer a2, s7_rf_t func)
- {
- s7_int loc;
- s7_pointer val_sym, val;
- s7_rf_t rf;
- s7_rp_t rp;
-
- val_sym = car(a2);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- rp = s7_rf_function(sc, val);
- if (!rp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = rp(sc, a2);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(func);
- }
-
- #define GEN_RF_1(Type, Func) \
- static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if ((g) && (mus_is_ ## Type(g))) {s7_xf_store(sc, (s7_pointer)g); return(Type ## _rf_g);} \
- return(NULL); \
- } \
- static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_xen *gn; \
- s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
- gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
- return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
- } \
- static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
- return(NULL); \
- }
-
- #define GEN_RF(Type, Func1, Func2) \
- static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- return(Func1(g)); \
- } \
- static s7_double Type ## _rf_gr(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer a2; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- a2 = (**p); (*p)++; \
- return(Func2(g, s7_number_to_real(sc, a2))); \
- } \
- static s7_double Type ## _rf_gs(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_double a2; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- a2 = s7_slot_real_value(sc, **p, #Type); (*p)++; \
- return(Func2(g, a2)); \
- } \
- static s7_double Type ## _rf_gx(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t f; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- f = (s7_rf_t)(**p); (*p)++; \
- return(Func2(g, f(sc, p))); \
- } \
- static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- g = cadr_gen(sc, expr); \
- if ((g) && (mus_is_ ## Type(g))) \
- { \
- s7_pointer a2; \
- s7_xf_store(sc, (s7_pointer)g); \
- if (s7_is_null(sc, s7_cddr(expr))) return(Type ## _rf_g); \
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL); \
- a2 = caddr(expr); \
- if (s7_is_real(a2)) {s7_xf_store(sc, a2); return(Type ## _rf_gr);} \
- if (s7_is_symbol(a2)) \
- { \
- s7_pointer slot; \
- slot = s7_slot(sc, a2); \
- if (slot != xen_undefined) {s7_xf_store(sc, (s7_pointer)slot); return(Type ## _rf_gs);} \
- return(NULL); \
- } \
- if (s7_is_pair(a2)) \
- return(caddr_rf(sc, a2, Type ## _rf_gx)); \
- } \
- return(NULL); \
- } \
- static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_xen *gn; \
- s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
- gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
- return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
- } \
- static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
- return(NULL); \
- }
-
- GEN_RF(all_pass, mus_all_pass_rf, mus_all_pass_unmodulated)
- GEN_RF(asymmetric_fm, mus_asymmetric_fm_rf, mus_asymmetric_fm_unmodulated)
- GEN_RF(comb, mus_comb_rf, mus_comb_unmodulated)
- GEN_RF(comb_bank, mus_comb_bank_rf, mus_comb_bank)
- GEN_RF(all_pass_bank, mus_all_pass_bank_rf, mus_all_pass_bank)
- GEN_RF_1(convolve, mus_convolve_rf)
- GEN_RF(delay, mus_delay_rf, mus_delay_unmodulated)
- GEN_RF_1(env, mus_env_rf)
- GEN_RF(filter, mus_filter_rf, mus_filter)
- GEN_RF(filtered_comb, mus_filtered_comb_rf, mus_filtered_comb_unmodulated)
- GEN_RF(filtered_comb_bank, mus_filtered_comb_bank_rf, mus_filtered_comb_bank)
- GEN_RF(fir_filter, mus_fir_filter_rf, mus_fir_filter)
- GEN_RF(firmant, mus_firmant_rf, mus_firmant)
- GEN_RF(formant, mus_formant_rf, mus_formant)
- GEN_RF_1(granulate, mus_granulate_rf)
- GEN_RF(iir_filter, mus_iir_filter_rf, mus_iir_filter)
- GEN_RF(moving_average, mus_moving_average_rf, mus_moving_average)
- GEN_RF(moving_max, mus_moving_max_rf, mus_moving_max)
- GEN_RF(moving_norm, mus_moving_norm_rf, mus_moving_norm)
- GEN_RF(ncos, mus_ncos_rf, mus_ncos)
- GEN_RF(notch, mus_notch_rf, mus_notch_unmodulated)
- GEN_RF(nrxycos, mus_nrxycos_rf, mus_nrxycos)
- GEN_RF(nrxysin, mus_nrxysin_rf, mus_nrxysin)
- GEN_RF(nsin, mus_nsin_rf, mus_nsin)
- GEN_RF(one_pole, mus_one_pole_rf, mus_one_pole)
- GEN_RF(one_pole_all_pass, mus_one_pole_all_pass_rf, mus_one_pole_all_pass)
- GEN_RF(one_zero, mus_one_zero_rf, mus_one_zero)
- GEN_RF(oscil, mus_oscil_rf, mus_oscil_fm)
- GEN_RF_1(oscil_bank, mus_oscil_bank_rf)
- GEN_RF_1(phase_vocoder, mus_phase_vocoder_rf)
- GEN_RF(polyshape, mus_polyshape_rf, mus_polyshape_unmodulated)
- GEN_RF(polywave, mus_polywave_rf, mus_polywave)
- GEN_RF(pulse_train, mus_pulse_train_rf, mus_pulse_train)
- GEN_RF(pulsed_env, mus_pulsed_env_rf, mus_pulsed_env)
- GEN_RF(rand, mus_rand_rf, mus_rand)
- GEN_RF(rand_interp, mus_rand_interp_rf, mus_rand_interp)
- GEN_RF_1(readin, mus_readin_rf)
- GEN_RF(rxykcos, mus_rxykcos_rf, mus_rxykcos)
- GEN_RF(rxyksin, mus_rxyksin_rf, mus_rxyksin)
- GEN_RF(sawtooth_wave, mus_sawtooth_wave_rf, mus_sawtooth_wave)
- GEN_RF(square_wave, mus_square_wave_rf, mus_square_wave)
- GEN_RF(src, mus_src_rf, mus_src_two)
- GEN_RF(table_lookup, mus_table_lookup_rf, mus_table_lookup)
- GEN_RF(triangle_wave, mus_triangle_wave_rf, mus_triangle_wave)
- GEN_RF(two_pole, mus_two_pole_rf, mus_two_pole)
- GEN_RF(two_zero, mus_two_zero_rf, mus_two_zero)
- GEN_RF(wave_train, mus_wave_train_rf, mus_wave_train)
- GEN_RF(ssb_am, mus_ssb_am_rf_1, mus_ssb_am_unmodulated)
- GEN_RF(tap, mus_tap_unmodulated, mus_tap)
-
- static s7_double oscil_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1, v2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- v2 = rf2(sc, p);
- return(mus_oscil(g, v1, v2));
- }
-
- static s7_double oscil_rf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- return(mus_oscil(g, s7_slot_real_value(sc, s1, S_oscil), v1));
- }
-
- static s7_double oscil_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_oscil(g, s7_slot_real_value(sc, s1, S_oscil), s7_slot_real_value(sc, s2, S_oscil)));
- }
-
- static s7_double oscil_rf_srs(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_oscil(g, s7_number_to_real(sc, s1), s7_slot_real_value(sc, s2, S_oscil)));
- }
-
- static s7_double oscil_rf_srx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- return(mus_oscil(g, s7_number_to_real(sc, s1), v1));
- }
-
-
- static s7_rf_t oscil_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
-
- len = s7_list_length(sc, expr);
- g = cadr_gen(sc, expr);
- if (!g) return(NULL);
- if (len < 4) return(oscil_rf(sc, expr));
- if (len > 5) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, oscil_rf_srs, oscil_rf_sss, NULL, oscil_rf_srx, oscil_rf_ssx, oscil_rf_sxx));
- }
-
-
- static s7_double comb_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_comb(g, v1, rf2(sc, p)));
- }
-
- static s7_double comb_rf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- return(mus_comb(g, s7_slot_real_value(sc, s1, S_comb), rf1(sc, p)));
- }
-
- static s7_double comb_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_comb(g, s7_slot_real_value(sc, s1, S_comb), s7_slot_real_value(sc, s2, S_comb)));
- }
-
- static s7_rf_t comb_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(comb_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_comb(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, comb_rf_sss, NULL, NULL, comb_rf_ssx, comb_rf_sxx));
- }
-
- static s7_double notch_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_notch(g, v1, rf2(sc, p)));
- }
-
- static s7_rf_t notch_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(notch_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_notch(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, notch_rf_sxx));
- }
-
- static s7_double delay_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_delay(g, v1, rf2(sc, p)));
- }
-
- static s7_rf_t delay_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(delay_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_delay(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, delay_rf_sxx));
- }
-
- static s7_double all_pass_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_all_pass(g, v1, rf2(sc, p)));
- }
-
- static s7_rf_t all_pass_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(all_pass_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_all_pass(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, all_pass_rf_sxx));
- }
-
- static s7_double ssb_am_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_ssb_am(g, s7_slot_real_value(sc, s1, S_ssb_am), s7_slot_real_value(sc, s2, S_ssb_am)));
- }
-
- static s7_rf_t ssb_am_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(ssb_am_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_ssb_am(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, ssb_am_rf_sss, NULL, NULL, NULL, NULL));
- }
-
- static s7_double formant_rf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, S_formant), rf1(sc, p)));
- }
-
- static s7_double formant_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, S_formant), s7_slot_real_value(sc, s2, S_formant)));
- }
-
- static s7_rf_t formant_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(formant_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_formant(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, formant_rf_sss, NULL, NULL, formant_rf_ssx, NULL));
- }
-
-
- /* formant-bank: c g r, or v for with_inputs */
- static s7_double formant_bank_rf_s(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_pointer slot;
- bank = (mus_any *)(**p); (*p)++;
- slot = (**p); (*p)++;
- return(mus_formant_bank(bank, s7_slot_real_value(sc, slot, S_formant_bank)));
- }
-
- static s7_double formant_bank_rf_r(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_pointer slot;
- bank = (mus_any *)(**p); (*p)++;
- slot = (**p); (*p)++;
- return(mus_formant_bank(bank, s7_number_to_real(sc, slot)));
- }
-
- static s7_double formant_bank_rf_x(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_rf_t r1;
- bank = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_formant_bank(bank, r1(sc, p)));
- }
-
- static s7_double formant_bank_rf_v(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_double *els;
- bank = (mus_any *)(**p); (*p)++;
- els = (s7_double *)(**p); (*p)++;
- return(mus_formant_bank_with_inputs(bank, els));
- }
-
- static s7_rf_t formant_bank_rf(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- g = cadr_gen(sc, expr);
- if ((g) && (mus_is_formant_bank(g)))
- {
- s7_pointer a1, val_sym, val;
- s7_int loc;
- s7_rf_t rf;
-
- s7_xf_store(sc, (s7_pointer)g);
- a1 = caddr(expr);
- if (s7_is_symbol(a1))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if (slot == xen_undefined) return(NULL);
- val = s7_slot_value(slot);
- if (s7_is_real(val))
- {
- s7_xf_store(sc, (s7_pointer)slot);
- return(formant_bank_rf_s);
- }
- if (s7_is_float_vector(val))
- {
- s7_xf_store(sc, (s7_pointer)s7_float_vector_elements(val));
- return(formant_bank_rf_v);
- }
- return(NULL);
- }
- if (s7_is_real(a1))
- {
- s7_xf_store(sc, a1);
- return(formant_bank_rf_r);
- }
- if (!s7_is_pair(a1)) return(NULL);
- val_sym = car(a1);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, a1);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(formant_bank_rf_x);
- }
- return(NULL);
- }
-
-
- static s7_double set_formant_frequency_rf_x(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *f;
- s7_rf_t r1;
- f = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_set_formant_frequency(f, r1(sc, p)));
- }
-
- static s7_rf_t set_formant_frequency_rf(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- g = cadr_gen(sc, expr);
- if ((g) && (mus_is_formant(g)))
- {
- s7_pointer a1;
- a1 = s7_caddr(expr);
- if (s7_is_pair(a1))
- {
- s7_int loc;
- s7_pointer val, val_sym;
- s7_rf_t rf;
- val_sym = car(a1);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, a1);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(set_formant_frequency_rf_x);
- }
- }
- return(NULL);
- }
-
-
- static s7_double outa_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(ind, val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_x_rf_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(s7_integer(ind), val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_s_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int ind;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- out_any_2(ind, val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_s_rf_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_pointer ind;
-
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- out_any_2(s7_integer(ind), val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_x_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- s7_rf_t rf;
-
- pos = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
- static s7_double outa_s_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
-
- pos = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
- static s7_double outb_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(ind, val, 1, S_outb);
- return(val);
- }
-
- static s7_double outb_s_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- s7_double val;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outb); (*p)++;
- out_any_2(ind, val, 1, S_outb);
- return(val);
- }
-
- static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p);
- static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p);
-
- static s7_double outa_mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- s7_rf_t r2;
- mus_any *g;
-
- pos = s7_slot_integer_value(**p); (*p) += 3;
- g = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- val = mus_env(g) * r2(sc, p);
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
- static s7_double outa_mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- s7_rf_t r2;
- mus_any *e, *o;
-
- pos = s7_slot_integer_value(**p); (*p) += 3;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- val = mus_env(e) * mus_polywave(o, r2(sc, p));
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
-
- static s7_double outa_mul_env_polywave_env_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- mus_any *e, *o, *fe;
-
- pos = s7_slot_integer_value(**p); (*p) += 3;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- fe = (mus_any *)(**p); (*p)++;
- val = mus_env(e) * mus_polywave(o, mus_env(fe));
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
-
- static s7_rf_t out_rf(s7_scheme *sc, s7_pointer expr, int chan)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_rf_t rf = NULL;
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- if (ind < 0) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- val_expr = s7_caddr(expr);
- if (s7_is_symbol(val_expr))
- {
- s7_pointer slot;
- slot = s7_slot(sc, val_expr);
- if (slot == xen_undefined) return(NULL);
- s7_xf_store(sc, slot);
- }
- else
- {
- s7_int loc;
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- }
-
- if (s7_is_stepper(ind_slot))
- {
- if (chan == 0)
- {
- if (out_any_2 == safe_out_any_2_to_mus_xen)
- {
- if (rf == mul_env_polywave_x_rf)
- {
- s7_pointer fm;
- fm = s7_caddr(s7_caddr(val_expr));
- if ((s7_is_pair(fm)) &&
- (s7_car(fm) == env_symbol) &&
- (s7_is_symbol(s7_cadr(fm))))
- return(outa_mul_env_polywave_env_rf);
- return(outa_mul_env_polywave_x_rf);
- }
- if (rf == mul_env_x_rf)
- return(outa_mul_env_x_rf);
- return((rf) ? outa_x_rf_to_mus_xen : outa_s_rf_to_mus_xen);
- }
- return((rf) ? outa_x_rf : outa_s_rf);
- }
- return((rf) ? outb_x_rf : outb_s_rf);
- }
-
- if (chan == 0)
- return((rf) ? outa_x_rf_checked : outa_s_rf_checked);
- return(NULL);
- }
-
- static s7_rf_t outa_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(out_rf(sc, expr, 0));
- }
-
- static s7_rf_t outb_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(out_rf(sc, expr, 1));
- }
-
-
- static s7_double sample_to_file_rf_g(s7_scheme *sc, s7_pointer **p)
- {
- /* (sample->file obj samp chan[always int] val) */
- s7_int ind, chan;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- chan = s7_integer(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_sample_to_file(lc, ind, chan, val);
- return(val);
- }
-
- static s7_rf_t sample_to_file_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, chan, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_sample_to_file(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- chan = s7_cadddr(expr);
- if (!s7_is_integer(chan)) return(NULL);
-
- val_expr = s7_car(s7_cddddr(expr));
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- s7_xf_store(sc, chan);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(sample_to_file_rf_g);
- }
-
-
- static s7_double locsig_rf_x(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_locsig(lc, ind, val);
- return(val);
- }
-
- static s7_double locsig_rf_x_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_locsig, 2, ind, "an integer");
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_locsig(lc, s7_integer(ind), val);
- return(val);
- }
-
- static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p);
-
- static s7_double locsig_fm_violin_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *lc, *e, *o, *fp, *a;
- s7_double val, vib;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p) += 3;
-
- /* fm_violin_rf */
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- vib = s7_slot_real_value(sc, **p, S_oscil); (*p) += 3;
- a = (mus_any *)(**p); (*p) += 2;
- fp = (mus_any *)(**p); (*p)++;
- val = mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib)));
-
- mus_locsig(lc, ind, val);
- return(val);
- }
-
- static s7_rf_t locsig_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_locsig(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- if (rf == fm_violin_rf)
- return(locsig_fm_violin_rf);
- return((s7_is_stepper(ind_slot)) ? locsig_rf_x : locsig_rf_x_checked);
- }
-
-
- static s7_double move_sound_rf_g(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_move_sound(lc, ind, val);
- return(val);
- }
-
- static s7_rf_t move_sound_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_move_sound(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(move_sound_rf_g);
- }
-
-
- static s7_double out_bank_rf_1(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1;
-
- g1 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- return(val);
- }
-
- static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p);
-
- static s7_double out_bank_rf_comb_bank_1(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val, s1;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *o;
-
- g1 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p) += 2;
-
- s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = s1 * mus_comb_bank(o, rf(sc, p));
-
- if (mus_is_delay(g1))
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- return(val);
- }
-
- static s7_double out_bank_rf_comb_bank_2(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val, s1;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2, *o;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p) += 2;
-
- s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = s1 * mus_comb_bank(o, rf(sc, p));
-
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- }
- return(val);
- }
-
- static s7_double out_bank_rf_2(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- }
- return(val);
- }
-
- static s7_double out_bank_rf_4(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2, *g3, *g4;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- g3 = (mus_any *)(**p); (*p)++;
- g4 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g3, val), 2, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g4, val), 3, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g3, val), 2, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g4, val), 3, "out-bank");
- }
- return(val);
- }
-
- static s7_rf_t out_bank_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr, filts;
- s7_int loc;
- s7_rf_t rf;
- s7_int i, len;
- mus_xen *gn;
- mus_any *g;
- s7_pointer *els;
-
- filts = s7_cadr(expr);
- if (!s7_is_symbol(filts)) return(NULL);
- filts = s7_symbol_value(sc, filts);
- if (!s7_is_vector(filts)) return(NULL);
- len = s7_vector_length(filts);
- if ((len != 1) && (len != 2) && (len != 4)) return(NULL);
- els = s7_vector_elements(filts);
- gn = (mus_xen *)s7_object_value_checked(els[0], mus_xen_tag);
- if (!gn) return(NULL);
- g = gn->gen;
- if ((!mus_is_delay(g)) && (!mus_is_all_pass(g))) return(NULL);
- for (i = 0; i < len; i++)
- s7_xf_store(sc, (s7_pointer)((mus_xen *)s7_object_value(els[i]))->gen);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- if (len == 1)
- {
- if (rf == mul_s_comb_bank_x_rf)
- return(out_bank_rf_comb_bank_1);
- return(out_bank_rf_1);
- }
- if (len == 2)
- {
- if (rf == mul_s_comb_bank_x_rf)
- return(out_bank_rf_comb_bank_2);
- return(out_bank_rf_2);
- }
- return(out_bank_rf_4);
- }
-
-
- static s7_double file_to_sample_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *stream;
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- return(mus_file_to_sample(stream, ind, 0));
- }
-
- static s7_rf_t file_to_sample_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, ind, sym, o;
- mus_xen *gn;
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- return(file_to_sample_rf_ss);
- }
-
-
- static s7_pointer file_to_frample_pf_sss(s7_scheme *sc, s7_pointer **p)
- {
- /* (file->frample gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- fv = s7_slot_value(**p); (*p)++;
- mus_file_to_frample(stream, ind, s7_float_vector_elements(fv));
- return(fv);
- }
-
- static s7_pf_t file_to_frample_pf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- fv_sym = s7_cadddr(expr);
- if (!s7_is_symbol(fv_sym)) return(NULL);
- fv_slot = s7_slot(sc, fv_sym);
- if (fv_slot == xen_undefined) return(NULL);
- if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
- s7_xf_store(sc, fv_slot);
-
- return(file_to_frample_pf_sss);
- }
-
-
- static s7_pointer frample_to_file_pf_sss(s7_scheme *sc, s7_pointer **p)
- {
- /* (frample->file gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- fv = s7_slot_value(**p); (*p)++;
- mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
- return(fv);
- }
-
- static s7_pointer frample_to_file_pf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- /* (frample->file gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- s7_pf_t pf;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
- return(fv);
- }
-
- static s7_pf_t frample_to_file_pf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
- mus_xen *gn;
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- fv_sym = s7_cadddr(expr);
- if (s7_is_symbol(fv_sym))
- {
- fv_slot = s7_slot(sc, fv_sym);
- if (fv_slot == xen_undefined) return(NULL);
- if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
- s7_xf_store(sc, fv_slot);
- return(frample_to_file_pf_sss);
- }
- if (s7_is_pair(fv_sym))
- {
- s7_pp_t pp;
- s7_pf_t pf;
- s7_int loc;
- pp = s7_pf_function(sc, s7_symbol_value(sc, s7_car(fv_sym)));
- if (!pp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- pf = pp(sc, fv_sym);
- if (!pf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)pf);
- return(frample_to_file_pf_ssx);
- }
- return(NULL);
- }
-
-
- static s7_pointer frample_to_frample_pf_all_s(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer matrix, in_data, in_chans, out_data, out_chans;
- matrix = s7_slot_value(**p); (*p)++;
- in_data = s7_slot_value(**p); (*p)++;
- in_chans = s7_slot_value(**p); (*p)++;
- out_data = s7_slot_value(**p); (*p)++;
- out_chans = s7_slot_value(**p); (*p)++;
-
- mus_frample_to_frample(s7_float_vector_elements(matrix), (int)sqrt(s7_vector_length(matrix)),
- s7_float_vector_elements(in_data), s7_integer(in_chans),
- s7_float_vector_elements(out_data), s7_integer(out_chans));
- return(out_data);
- }
-
- static s7_pf_t frample_to_frample_pf(s7_scheme *sc, s7_pointer expr)
- {
- s7_int i;
- s7_pointer p;
- for (i = 0, p = s7_cdr(expr); (s7_is_pair(p)) && (i < 5); i++, p = s7_cdr(p))
- {
- if (s7_is_symbol(s7_car(p)))
- {
- s7_pointer slot;
- slot = s7_slot(sc, s7_car(p));
- if (slot == xen_undefined) return(NULL);
- s7_xf_store(sc, slot);
- }
- else return(NULL);
- }
- if ((i == 5) && (s7_is_null(sc, p)))
- return(frample_to_frample_pf_all_s);
- return(NULL);
- }
-
- static s7_double ina_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, 0, stream));
- }
-
- static s7_double ina_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- mus_any *stream;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_ina, 1, ind, "an integer");
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(s7_integer(ind), 0, stream));
- }
-
- static s7_double inb_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, 1, stream));
- }
-
- static s7_double inb_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- mus_any *stream;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_inb, 1, ind, "an integer");
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(s7_integer(ind), 1, stream));
- }
-
- static s7_double ina_rf_fv(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer fv;
- s7_int index;
- index = s7_slot_integer_value(**p); (*p)++;
- fv = (**p); (*p)++;
- if ((index >= 0) && (index < s7_vector_length(fv)))
- return(s7_float_vector_elements(fv)[index]);
- return(0.0);
- }
-
- static s7_rf_t in_rf(s7_scheme *sc, s7_pointer expr, int chan)
- {
- s7_pointer ind_sym, ind_slot, ind, sym, o;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- sym = s7_caddr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- if (s7_is_float_vector(o))
- {
- if ((chan == 0) &&
- (s7_is_stepper(ind_slot)))
- {
- s7_xf_store(sc, o);
- return(ina_rf_fv);
- }
- return(NULL);
- }
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
- if (s7_is_stepper(ind_slot))
- {
- if (chan == 0)
- return(ina_rf_ss);
- return(inb_rf_ss);
- }
- if (chan == 0)
- return(ina_rf_ss_checked);
- return(inb_rf_ss_checked);
- }
-
- static s7_rf_t ina_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(in_rf(sc, expr, 0));
- }
-
- static s7_rf_t inb_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(in_rf(sc, expr, 1));
- }
-
- static s7_double in_any_rf_srs(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind, chan;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- chan = s7_integer(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, chan, stream));
- }
-
- static s7_rf_t in_any_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, ind, sym, o, chan;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- chan = s7_caddr(expr);
- if (!s7_is_integer(chan)) return(NULL);
- s7_xf_store(sc, chan);
-
- sym = s7_cadddr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
- return(in_any_rf_srs);
- }
-
-
- #define RF2_TO_RF(CName, Rfnc) \
- static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t f; \
- s7_double x, y; \
- f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); \
- f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); \
- return(Rfnc); \
- } \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_rf(sc, s7_cadr(expr))) && \
- (s7_arg_to_rf(sc, s7_caddr(expr)))) \
- return(CName ## _rf_r2); \
- return(NULL); \
- }
-
- #define RF_0(Call) \
- static s7_double Call ## _rf_0(s7_scheme *sc, s7_pointer **p) \
- { \
- return(mus_ ## Call()); \
- } \
- static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cdr(expr))) return(NULL); \
- return(Call ## _rf_0); \
- }
-
- RF_0(srate)
-
-
- #define RF_1(Call) \
- static s7_double Call ## _rf_s(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer slot; \
- slot = (**p); (*p)++; \
- return(mus_ ## Call(s7_slot_real_value(sc, slot, #Call))); \
- } \
- static s7_double Call ## _rf_c(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer slot; \
- slot = (**p); (*p)++; \
- return(mus_ ## Call(s7_number_to_real(sc, slot))); \
- } \
- static s7_double Call ## _rf_r(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t r; \
- r = (s7_rf_t)(**p); (*p)++; \
- return(mus_ ## Call(r(sc, p))); \
- } \
- static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- return(s7_rf_1(sc, expr, Call ## _rf_c, Call ## _rf_s, Call ## _rf_r)); \
- }
-
- RF_1(odd_weight)
- RF_1(even_weight)
- RF_1(hz_to_radians)
- RF_1(radians_to_hz)
- RF_1(db_to_linear)
- RF_1(linear_to_db)
- RF_1(radians_to_degrees)
- RF_1(degrees_to_radians)
- RF_1(random)
-
- RF2_TO_RF(contrast_enhancement, mus_contrast_enhancement(x, y))
- RF2_TO_RF(odd_multiple, mus_odd_multiple(x, y))
- RF2_TO_RF(even_multiple, mus_even_multiple(x, y))
- RF2_TO_RF(ring_modulate, x * y)
-
-
- static s7_double polynomial_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_double s2;
- s1 = s7_slot_value(**p); (*p)++;
- s2 = s7_slot_real_value(sc, **p, "polynomial"); (*p)++;
- return(mus_polynomial(s7_float_vector_elements(s1), s2, s7_vector_length(s1)));
- }
-
- static s7_double polynomial_rf_sx(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_rf_t r1;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_polynomial(s7_float_vector_elements(s1), r1(sc, p), s7_vector_length(s1)));
- }
-
- static s7_rf_t polynomial_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_symbol(s7_cadr(expr))) &&
- (s7_is_float_vector(s7_symbol_value(sc, s7_cadr(expr)))))
- return(s7_rf_2(sc, expr, NULL, NULL, NULL, NULL, polynomial_rf_ss, NULL, NULL, polynomial_rf_sx, NULL));
- return(NULL);
- }
-
- static s7_double pink_noise_rf_v(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s1 = s7_slot_value(**p); (*p)++;
- return(mus_pink_noise(s1));
- }
-
- static s7_rf_t pink_noise_rf(s7_scheme *sc, s7_pointer expr)
- {
- if (s7_is_symbol(s7_cadr(expr)))
- {
- s7_pointer slot;
- slot = s7_slot(sc, s7_cadr(expr));
- if (s7_is_float_vector(s7_slot_value(slot)))
- {
- s7_xf_store(sc, slot);
- return(pink_noise_rf_v);
- }
- }
- return(NULL);
- }
-
- static s7_double piano_noise_rf_vr(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_double s2;
- s1 = s7_slot_value(**p); (*p)++;
- s2 = s7_slot_real_value(sc, **p, "piano-noise"); (*p)++;
- return(piano_noise(s7_int_vector_elements(s1), s2));
- }
-
- static s7_rf_t piano_noise_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_symbol(s7_cadr(expr))) &&
- (s7_is_symbol(s7_caddr(expr))))
- {
- s7_pointer slot1, slot2;
- slot1 = s7_slot(sc, s7_cadr(expr));
- slot2 = s7_slot(sc, s7_caddr(expr));
- if ((s7_is_int_vector(s7_slot_value(slot1))) &&
- (s7_is_real(s7_slot_value(slot2))))
- {
- s7_xf_store(sc, slot1);
- s7_xf_store(sc, slot2);
- return(piano_noise_rf_vr);
- }
- }
- return(NULL);
- }
-
-
- static s7_double array_interp_rf_sxr(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_int c2;
- s7_rf_t r1;
- s7_double x;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- c2 = s7_integer(**p); (*p)++;
- return(mus_array_interp(s7_float_vector_elements(s1), x, c2));
- }
-
- static s7_double array_interp_rf_sxs(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_int s2;
- s7_rf_t r1;
- s7_double x;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- s2 = s7_slot_integer_value(**p); (*p)++;
- return(mus_array_interp(s7_float_vector_elements(s1), x, s2));
- }
-
- static s7_rf_t array_interp_rf(s7_scheme *sc, s7_pointer expr)
- {
- if (s7_is_symbol(s7_cadr(expr)))
- {
- s7_pointer rst, fv;
- rst = cdr(expr);
- fv = s7_slot(sc, s7_car(rst));
- if ((fv != xen_undefined) &&
- (s7_is_float_vector(s7_slot_value(fv))))
- {
- if ((!s7_is_null(sc, s7_cddr(rst))) &&
- (s7_is_null(sc, s7_cdddr(rst))))
- {
- s7_xf_store(sc, fv);
- return(s7_rf_2(sc, rst, NULL, NULL, array_interp_rf_sxr, NULL, NULL, array_interp_rf_sxs, NULL, NULL, NULL));
- }
- }
- }
- return(NULL);
- }
-
- static s7_double am_rf_rsx(s7_scheme *sc, s7_pointer **p)
- {
- s7_double c1, c2;
- s7_rf_t r1;
- c1 = s7_number_to_real(sc, **p); (*p)++;
- c2 = s7_slot_real_value(sc, **p, "amplitude-modulation"); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_amplitude_modulate(c1, c2, r1(sc, p)));
- }
-
- static s7_rf_t am_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer a1, a2, a3;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- a3 = s7_cadddr(expr);
- if ((s7_is_real(a1)) &&
- (s7_is_symbol(a2)) &&
- (s7_is_pair(a3)))
- {
- s7_rp_t rp;
- s7_rf_t rf;
- s7_int loc;
- s7_pointer sym, val;
-
- s7_xf_store(sc, a1);
- val = s7_slot(sc, a2);
- if (val == xen_undefined) return(NULL);
- s7_xf_store(sc, val);
-
- sym = car(a3);
- if (!s7_is_symbol(sym)) return(NULL);
- val = s7_symbol_value(sc, sym);
- rp = s7_rf_function(sc, val);
- if (!rp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = rp(sc, a3);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(am_rf_rsx);
- }
- return(NULL);
- }
-
-
- static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r2;
- mus_any *g;
- (*p)++;
- g = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(g) * r2(sc, p));
- }
-
- static s7_double mul_env_oscil_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r2;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(e) * mus_oscil_fm(o, r2(sc, p)));
- }
-
- static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *e, *o, *fp, *a;
- s7_double vib;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- vib = s7_slot_real_value(sc, **p, S_oscil); (*p) += 3;
- a = (mus_any *)(**p); (*p) += 2;
- fp = (mus_any *)(**p); (*p)++;
- return(mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib))));
- }
-
- static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r2;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(e) * mus_polywave(o, r2(sc, p)));
- }
-
- static s7_double mul_env_polywave_s_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double s1;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- s1 = s7_slot_real_value(sc, **p, S_polywave); (*p)++;
- return(mus_env(e) * mus_polywave(o, s1));
- }
-
- static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r1;
- s7_double s1;
- mus_any *o;
- s1 = s7_slot_real_value(sc, **p, S_comb_bank); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(s1 * mus_comb_bank(o, r1(sc, p)));
- }
-
- static s7_rp_t initial_multiply_rf;
- static s7_rf_t clm_multiply_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_rf_t f;
- f = initial_multiply_rf(sc, expr);
- if ((f) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- s7_pointer a1, a2;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- if (s7_is_pair(a1))
- {
- if ((s7_car(a1) == env_symbol) &&
- (s7_is_pair(a2)) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- if ((s7_is_symbol(s7_cadr(a2))) &&
- (s7_is_null(sc, s7_cdddr(a2))))
- {
- if (s7_is_pair(s7_caddr(a2)))
- {
- if (s7_car(a2) == oscil_symbol)
- {
- s7_pointer fm;
- fm = s7_caddr(a2);
- if ((s7_car(fm) == add_symbol) &&
- (s7_is_symbol(s7_cadr(fm))) &&
- (s7_is_pair(s7_caddr(fm))))
- {
- s7_pointer vib_sym;
- vib_sym = s7_cadr(fm);
- fm = s7_caddr(fm);
- if ((s7_car(fm) == multiply_symbol) &&
- (s7_is_pair(s7_cadr(fm))) &&
- (s7_caadr(fm) == env_symbol) &&
- (s7_is_pair(s7_caddr(fm))) &&
- (s7_is_null(sc, s7_cdddr(fm))))
- {
- fm = s7_caddr(fm);
- if ((s7_car(fm) == polywave_symbol) &&
- (s7_is_symbol(s7_cadr(fm))) &&
- (s7_is_symbol(s7_caddr(fm))) &&
- (s7_caddr(fm) == vib_sym))
- return(fm_violin_rf);
- }
- }
- return(mul_env_oscil_x_rf);
- }
- else
- {
- if (s7_car(a2) == polywave_symbol)
- return(mul_env_polywave_x_rf);
- }
- }
- if (s7_is_symbol(s7_caddr(a2)))
- {
- if (s7_car(a2) == polywave_symbol)
- return(mul_env_polywave_s_rf);
- }
- }
- return(mul_env_x_rf);
- }
- }
- else
- {
- if ((s7_is_symbol(a1)) &&
- (s7_is_pair(a2)) &&
- (s7_is_symbol(s7_cadr(a2))) &&
- (s7_car(a2) == comb_bank_symbol) &&
- (s7_is_pair(s7_caddr(a2))) &&
- (s7_is_null(sc, s7_cdddr(a2))))
- return(mul_s_comb_bank_x_rf);
- }
- }
- return(f);
- }
-
-
- static s7_double add_env_ri_rf(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- return(mus_env(e) + mus_rand_interp_unmodulated(o));
- }
-
- static s7_double add_tri_ri_rf(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *e, *o;
- (*p)++; /* triangle-wave */
- e = (mus_any *)(**p); (*p) += 2; /* rand-interp */
- o = (mus_any *)(**p); (*p)++;
- return(mus_triangle_wave_unmodulated(e) + mus_rand_interp_unmodulated(o));
- }
-
- static s7_rp_t initial_add_rf;
- static s7_rf_t clm_add_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_rf_t f;
- f = initial_add_rf(sc, expr);
- if (f)
- {
- s7_pointer a1, a2;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- if ((s7_is_pair(a1)) &&
- (s7_is_pair(a2)) &&
- (s7_car(a2) == rand_interp_symbol) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_symbol(s7_cadr(a2))) &&
- (s7_is_null(sc, s7_cddr(a1))) &&
- (s7_is_null(sc, s7_cddr(a2))) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- if (s7_car(a1) == triangle_wave_symbol)
- return(add_tri_ri_rf);
- if (s7_car(a1) == env_symbol)
- return(add_env_ri_rf);
- }
- }
- return(f);
- }
-
-
- static s7_double env_rf_v(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer v;
- mus_xen *gn;
- s7_Int ind;
-
- v = (**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- if ((ind < 0) || (ind >= s7_vector_length(v)))
- s7_out_of_range_error(s7, "vector-ref", 2, s7_make_integer(sc, ind), "must fit in vector");
-
- gn = (mus_xen *)s7_object_value_checked(s7_vector_elements(v)[ind], mus_xen_tag);
- return(mus_env(gn->gen));
- }
-
- static s7_rf_t env_rf_1(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(expr)) &&
- (s7_is_pair(cdr(expr))) &&
- (s7_is_pair(cadr(expr))))
- {
- s7_pointer a1;
- a1 = s7_cadr(expr);
- if ((s7_car(a1) == vector_ref_symbol) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_symbol(s7_caddr(a1))) &&
- (s7_is_null(sc, s7_cdddr(a1))))
- {
- s7_pointer s1, s2, v, ind;
- s7_pointer *els;
- int i, vlen;
-
- s1 = s7_cadr(a1);
- s2 = s7_caddr(a1);
-
- v = s7_symbol_value(sc, s1);
- if (!s7_is_vector(v)) return(NULL);
- vlen = s7_vector_length(v);
- els = s7_vector_elements(v);
- for (i= 0; i < vlen; i++)
- {
- mus_xen *gn;
- gn = (mus_xen *)s7_object_value_checked(els[i], mus_xen_tag);
- if ((!gn) || (!(gn->gen)) || (!mus_is_env(gn->gen))) return(NULL);
- }
-
- ind = s7_slot(sc, s2);
- if ((ind == xen_undefined) || (!s7_is_integer(s7_slot_value(ind)))) return(NULL);
-
- s7_xf_store(sc, v);
- s7_xf_store(sc, ind);
- return(env_rf_v);
- }
- }
- return(env_rf(sc, expr));
- }
-
-
- static s7_double chebyshev_t_rf_a(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer fv;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- return(mus_chebyshev_t_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
- }
-
- static s7_rf_t chebyshev_t_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))))
- return(chebyshev_t_rf_a);
- return(NULL);
- }
-
- static s7_double chebyshev_u_rf_a(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer fv;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- return(mus_chebyshev_u_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
- }
-
- static s7_rf_t chebyshev_u_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))))
- return(chebyshev_u_rf_a);
- return(NULL);
- }
-
- static s7_double chebyshev_tu_rf_a(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer t, u;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- t = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- u = pf(sc, p);
- return(mus_chebyshev_tu_sum(x, s7_vector_length(t), s7_float_vector_elements(t), s7_float_vector_elements(u)));
- }
-
- static s7_rf_t chebyshev_tu_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_pair(s7_cdddr(expr))) && (s7_is_null(sc, s7_cddddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))) &&
- (s7_arg_to_pf(sc, s7_cadddr(expr))))
- return(chebyshev_tu_rf_a);
- return(NULL);
- }
-
-
- #define PF2_TO_RF(CName, Cfnc) \
- static s7_double CName ## _rf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x, y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- f = (s7_pf_t)(**p); (*p)++; \
- y = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_pf(sc, s7_caddr(expr)))) \
- return(CName ## _rf_a); \
- return(NULL); \
- }
-
- static s7_double c_dot_product(s7_scheme *sc, s7_pointer x, s7_pointer y)
- {
- s7_int len, lim;
- len = s7_vector_length(x);
- lim = s7_vector_length(y);
- if (lim < len) len = lim;
- if (len == 0) return(0.0);
- return(mus_dot_product(s7_float_vector_elements(x), s7_float_vector_elements(y), len));
- }
-
- PF2_TO_RF(dot_product, c_dot_product(sc, x, y))
-
- static s7_pointer mus_fft_pf_i2(s7_scheme *sc, s7_pointer **p)
- {
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer rl, im;
- s7_int size, dir;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; dir = xf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, dir);
- return(rl);
- }
-
- static s7_pointer mus_fft_pf_i1(s7_scheme *sc, s7_pointer **p)
- {
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer rl, im;
- s7_int size;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, 1);
- return(rl);
- }
-
- static s7_pointer mus_fft_pf_i0(s7_scheme *sc, s7_pointer **p)
- {
- s7_pf_t pf;
- s7_pointer rl, im;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), s7_vector_length(rl), 1);
- return(rl);
- }
-
- static s7_pf_t mus_fft_pf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))))
- {
- s7_pointer trailers;
- if (!s7_arg_to_pf(sc, s7_cadr(expr))) return(NULL);
- if (!s7_arg_to_pf(sc, s7_caddr(expr))) return(NULL);
- trailers = s7_cdddr(expr);
- if (s7_is_null(sc, trailers)) return(mus_fft_pf_i0);
- if (!s7_arg_to_if(sc, s7_car(trailers))) return(NULL);
- if (s7_is_null(sc, s7_cdr(trailers))) return(mus_fft_pf_i1);
- if (!s7_arg_to_if(sc, s7_cadr(trailers))) return(NULL);
- if (!s7_is_null(sc, s7_cddr(trailers))) return(NULL);
- return(mus_fft_pf_i2);
- }
- return(NULL);
- }
-
-
- #define MG_RF(Method, Func) \
- static s7_double mus_ ## Method ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_rf_t mus_ ## Method ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _rf_g);} \
- return(NULL); \
- }
-
- #define MG_IF(Method, Func) \
- static s7_int mus_ ## Method ## _if_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_if_t mus_ ## Method ## _if(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _if_g);} \
- return(NULL); \
- }
-
- #define PF_PF(Method, Func) \
- static s7_pointer mus_ ## Method ## _pf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer g; \
- f = (s7_pf_t)(**p); (*p)++; \
- g = f(sc, p); \
- return(Func(g)); \
- } \
- static s7_pf_t mus_ ## Method ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(mus_ ## Method ## _pf_g); \
- return(NULL); \
- }
-
- MG_RF(scaler, mus_scaler)
- MG_RF(phase, mus_phase)
- MG_RF(frequency, mus_frequency)
- MG_RF(offset, mus_offset)
- MG_RF(width, mus_width)
- MG_RF(increment, mus_increment)
- MG_RF(feedforward, mus_feedforward)
- MG_RF(feedback, mus_feedback)
-
- MG_IF(length, mus_length)
- MG_IF(order, mus_order)
- MG_IF(location, mus_location)
- MG_IF(channel, mus_channel)
- MG_IF(channels, mus_channels)
- MG_IF(ramp, mus_ramp)
- MG_IF(hop, mus_hop)
-
-
- PF_PF(data, g_mus_data)
- PF_PF(reset, g_mus_reset)
-
- #if 0
- MG_RFIF(xcoeff, mus_xcoeff)
- MG_RFIF(ycoeff, mus_ycoeff)
- MG_PF(xcoeffs, c_mus_xcoeffs) -- x|ycoeffs are complicated and may involve wrapper creation
- MG_PF(ycoeffs, c_mus_ycoeffs)
- MG_PF(file_name, c_mus_file_name) -- requires c->xen string creation
- MG_PF(copy, c_mus_copy) -- allocation
- #endif
- #endif /* gmp */
-
-
- static void init_choosers(s7_scheme *sc)
- {
- #if (!WITH_GMP)
- s7_pointer f;
- #endif
-
- env_symbol = s7_make_symbol(sc, S_env);
- comb_bank_symbol = s7_make_symbol(sc, S_comb_bank);
- vector_ref_symbol = s7_make_symbol(sc, "vector-ref");
- polywave_symbol = s7_make_symbol(sc, S_polywave);
- triangle_wave_symbol = s7_make_symbol(sc, S_triangle_wave);
- rand_interp_symbol = s7_make_symbol(sc, S_rand_interp);
- oscil_symbol = s7_make_symbol(sc, S_oscil);
- multiply_symbol = s7_make_symbol(sc, "*");
- add_symbol = s7_make_symbol(sc, "+");
- quote_symbol = s7_make_symbol(sc, "quote");
- cos_symbol = s7_make_symbol(sc, "cos");
- mus_copy_symbol = s7_make_symbol(sc, "mus-copy");
- copy_function = s7_name_to_value(sc, "copy");
-
- sym_frequency = s7_make_symbol(sc, S_mus_frequency);
- sym_phase = s7_make_symbol(sc, S_mus_phase);
- sym_scaler = s7_make_symbol(sc, S_mus_scaler);
- sym_increment = s7_make_symbol(sc, S_mus_increment);
- sym_width = s7_make_symbol(sc, S_mus_width);
- sym_offset = s7_make_symbol(sc, S_mus_offset);
- sym_feedforward = s7_make_symbol(sc, S_mus_feedforward);
- sym_feedback = s7_make_symbol(sc, S_mus_feedback);
-
- #if (!WITH_GMP)
- f = s7_name_to_value(sc, "*");
- initial_multiply_rf = s7_rf_function(sc, f);
- s7_rf_set_function(f, clm_multiply_rf);
-
- f = s7_name_to_value(sc, "+");
- initial_add_rf = s7_rf_function(sc, f);
- s7_rf_set_function(f, clm_add_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_outa), outa_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_outb), outb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ina), ina_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_file_to_sample), file_to_sample_rf);
- s7_pf_set_function(s7_name_to_value(sc, S_file_to_frample), file_to_frample_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_frample_to_file), frample_to_file_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_frample_to_frample), frample_to_frample_pf);
- s7_rf_set_function(s7_name_to_value(sc, S_oscil), oscil_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_polywave), polywave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_wave_train), wave_train_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_granulate), granulate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ncos), ncos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nrxycos), nrxycos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_env), env_rf_1);
- s7_rf_set_function(s7_name_to_value(sc, S_readin), readin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_one_pole), one_pole_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_average), moving_average_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_max), moving_max_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_fir_filter), fir_filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_triangle_wave), triangle_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pulse_train), pulse_train_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rand_interp), rand_interp_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_formant), formant_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_one_pole_all_pass), one_pole_all_pass_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_delay), delay_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_formant_bank), formant_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_oscil_bank), oscil_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rand), rand_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filter), filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_table_lookup), table_lookup_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_src), src_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_sawtooth_wave), sawtooth_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_inb), inb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_in_any), in_any_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_polynomial), polynomial_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pink_noise), pink_noise_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_piano_noise), piano_noise_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nsin), nsin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nrxysin), nrxysin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rxyksin), rxyksin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rxykcos), rxykcos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_tap), tap_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_comb), comb_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_comb_bank), comb_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_notch), notch_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_two_zero), two_zero_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_one_zero), one_zero_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_two_pole), two_pole_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_norm), moving_norm_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_iir_filter), iir_filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_square_wave), square_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_firmant), firmant_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_all_pass), all_pass_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_all_pass_bank), all_pass_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_polyshape), polyshape_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pulsed_env), pulsed_env_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ssb_am), ssb_am_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_asymmetric_fm), asymmetric_fm_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb), filtered_comb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb_bank), filtered_comb_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_move_sound), move_sound_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_locsig), locsig_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_out_bank), out_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_phase_vocoder), phase_vocoder_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_convolve), convolve_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_sample_to_file), sample_to_file_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_srate), srate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_contrast_enhancement), contrast_enhancement_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_set_formant_frequency), set_formant_frequency_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_odd_weight), odd_weight_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_even_weight), even_weight_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_odd_multiple), odd_multiple_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_even_multiple), even_multiple_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_hz_to_radians), hz_to_radians_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_radians_to_hz), radians_to_hz_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_radians_to_degrees), radians_to_degrees_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_degrees_to_radians), degrees_to_radians_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_db_to_linear), db_to_linear_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_linear_to_db), linear_to_db_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_mus_random), random_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_amplitude_modulate), am_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ring_modulate), ring_modulate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_array_interp), array_interp_rf);
-
- s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass), is_all_pass_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_asymmetric_fm), is_asymmetric_fm_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_comb), is_comb_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_comb_bank), is_comb_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass_bank), is_all_pass_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_convolve), is_convolve_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_delay), is_delay_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_env), is_env_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filter), is_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb), is_filtered_comb_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb_bank), is_filtered_comb_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_fir_filter), is_fir_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_firmant), is_firmant_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_formant), is_formant_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_granulate), is_granulate_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_iir_filter), is_iir_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_average), is_moving_average_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_max), is_moving_max_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_norm), is_moving_norm_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_ncos), is_ncos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_notch), is_notch_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nrxycos), is_nrxycos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nrxysin), is_nrxysin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nsin), is_nsin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole), is_one_pole_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole_all_pass), is_one_pole_all_pass_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_zero), is_one_zero_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_oscil), is_oscil_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_oscil_bank), is_oscil_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_phase_vocoder), is_phase_vocoder_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_polyshape), is_polyshape_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_polywave), is_polywave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_pulse_train), is_pulse_train_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_pulsed_env), is_pulsed_env_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rand), is_rand_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rand_interp), is_rand_interp_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_readin), is_readin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rxykcos), is_rxykcos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rxyksin), is_rxyksin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_sawtooth_wave), is_sawtooth_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_square_wave), is_square_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_src), is_src_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_table_lookup), is_table_lookup_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_triangle_wave), is_triangle_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_two_pole), is_two_pole_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_two_zero), is_two_zero_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_wave_train), is_wave_train_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_ssb_am), is_ssb_am_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_tap), is_tap_pf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_dot_product), dot_product_rf);
- s7_pf_set_function(s7_name_to_value(sc, S_mus_fft), mus_fft_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_polar), rectangular_to_polar_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_polar_to_rectangular), polar_to_rectangular_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_magnitudes), rectangular_to_magnitudes_pf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_t_sum), chebyshev_t_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_u_sum), chebyshev_u_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_tu_sum), chebyshev_tu_rf);
-
- s7_pf_set_function(s7_name_to_value(sc, S_mus_data), mus_data_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_mus_reset), mus_reset_pf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_mus_scaler), mus_scaler_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_phase), mus_phase_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_frequency), mus_frequency_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_offset), mus_offset_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_width), mus_width_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_increment), mus_increment_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_feedforward), mus_feedforward_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_feedback), mus_feedback_rf);
-
- s7_if_set_function(s7_name_to_value(sc, S_mus_length), mus_length_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_order), mus_order_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_location), mus_location_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_channel), mus_channel_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_channels), mus_channels_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_ramp), mus_ramp_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_hop), mus_hop_if);
- #endif /* gmp */
- }
- #endif /*s7 */
-
-
- Xen_wrap_no_args(g_mus_srate_w, g_mus_srate)
- Xen_wrap_1_arg(g_mus_set_srate_w, g_mus_set_srate)
- Xen_wrap_no_args(g_mus_float_equal_fudge_factor_w, g_mus_float_equal_fudge_factor)
- Xen_wrap_1_arg(g_mus_set_float_equal_fudge_factor_w, g_mus_set_float_equal_fudge_factor)
- Xen_wrap_no_args(g_mus_array_print_length_w, g_mus_array_print_length)
- Xen_wrap_1_arg(g_mus_set_array_print_length_w, g_mus_set_array_print_length)
- Xen_wrap_1_arg(g_radians_to_hz_w, g_radians_to_hz)
- Xen_wrap_1_arg(g_hz_to_radians_w, g_hz_to_radians)
- Xen_wrap_1_arg(g_radians_to_degrees_w, g_radians_to_degrees)
- Xen_wrap_1_arg(g_degrees_to_radians_w, g_degrees_to_radians)
- Xen_wrap_1_arg(g_db_to_linear_w, g_db_to_linear)
- Xen_wrap_1_arg(g_linear_to_db_w, g_linear_to_db)
- Xen_wrap_1_arg(g_even_weight_w, g_even_weight)
- Xen_wrap_1_arg(g_odd_weight_w, g_odd_weight)
- Xen_wrap_2_args(g_even_multiple_w, g_even_multiple)
- Xen_wrap_2_args(g_odd_multiple_w, g_odd_multiple)
- Xen_wrap_1_arg(g_seconds_to_samples_w, g_seconds_to_samples)
- Xen_wrap_1_arg(g_samples_to_seconds_w, g_samples_to_seconds)
- Xen_wrap_2_args(g_ring_modulate_w, g_ring_modulate)
- Xen_wrap_3_args(g_amplitude_modulate_w, g_amplitude_modulate)
- Xen_wrap_2_optional_args(g_contrast_enhancement_w, g_contrast_enhancement)
- Xen_wrap_3_optional_args(g_dot_product_w, g_dot_product)
- #if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
- Xen_wrap_2_args(g_edot_product_w, g_edot_product)
- #endif
- Xen_wrap_2_args(g_polynomial_w, g_polynomial)
- Xen_wrap_4_optional_args(g_make_fft_window_w, g_make_fft_window)
- Xen_wrap_4_optional_args(g_mus_fft_w, g_mus_fft)
- Xen_wrap_4_optional_args(g_spectrum_w, g_spectrum)
- Xen_wrap_1_arg(g_autocorrelate_w, g_autocorrelate)
- Xen_wrap_2_args(g_correlate_w, g_correlate)
- Xen_wrap_3_optional_args(g_convolution_w, g_convolution)
- Xen_wrap_2_args(g_rectangular_to_polar_w, g_rectangular_to_polar)
- Xen_wrap_2_args(g_rectangular_to_magnitudes_w, g_rectangular_to_magnitudes)
- Xen_wrap_2_args(g_polar_to_rectangular_w, g_polar_to_rectangular)
- Xen_wrap_3_optional_args(g_array_interp_w, g_array_interp)
- Xen_wrap_5_optional_args(g_mus_interpolate_w, g_mus_interpolate)
- Xen_wrap_1_arg(g_mus_describe_w, g_mus_describe)
- Xen_wrap_1_arg(g_mus_name_w, g_mus_name)
- Xen_wrap_3_optional_args(g_mus_run_w, g_mus_run)
- Xen_wrap_1_arg(g_mus_phase_w, g_mus_phase)
- Xen_wrap_2_args(g_mus_set_phase_w, g_mus_set_phase)
- Xen_wrap_1_arg(g_mus_width_w, g_mus_width)
- Xen_wrap_2_args(g_mus_set_width_w, g_mus_set_width)
- Xen_wrap_1_arg(g_mus_scaler_w, g_mus_scaler)
- Xen_wrap_2_args(g_mus_set_scaler_w, g_mus_set_scaler)
- Xen_wrap_1_arg(g_mus_feedforward_w, g_mus_feedforward)
- Xen_wrap_2_args(g_mus_set_feedforward_w, g_mus_set_feedforward)
- Xen_wrap_1_arg(g_mus_reset_w, g_mus_reset)
- Xen_wrap_1_arg(g_mus_copy_w, g_mus_copy)
- Xen_wrap_1_arg(g_mus_offset_w, g_mus_offset)
- Xen_wrap_2_args(g_mus_set_offset_w, g_mus_set_offset)
- Xen_wrap_1_arg(g_mus_frequency_w, g_mus_frequency)
- Xen_wrap_2_args(g_mus_set_frequency_w, g_mus_set_frequency)
- Xen_wrap_1_arg(g_mus_length_w, g_mus_length)
- Xen_wrap_1_arg(g_mus_file_name_w, g_mus_file_name)
- Xen_wrap_2_args(g_mus_set_length_w, g_mus_set_length)
- Xen_wrap_1_arg(g_mus_type_w, g_mus_type)
- Xen_wrap_1_arg(g_mus_order_w, g_mus_order)
- Xen_wrap_1_arg(g_mus_data_w, g_mus_data)
- Xen_wrap_2_args(g_mus_set_data_w, g_mus_set_data)
- Xen_wrap_1_arg(g_is_oscil_w, g_is_oscil)
- Xen_wrap_3_optional_args(g_oscil_w, g_oscil)
- Xen_wrap_1_arg(g_is_oscil_bank_w, g_is_oscil_bank)
- Xen_wrap_1_arg(g_oscil_bank_w, g_oscil_bank)
- Xen_wrap_any_args(g_mus_apply_w, g_mus_apply)
- Xen_wrap_any_args(g_make_delay_w, g_make_delay)
- Xen_wrap_any_args(g_make_comb_w, g_make_comb)
- Xen_wrap_any_args(g_make_filtered_comb_w, g_make_filtered_comb)
- Xen_wrap_any_args(g_make_notch_w, g_make_notch)
- Xen_wrap_any_args(g_make_all_pass_w, g_make_all_pass)
- Xen_wrap_any_args(g_make_moving_average_w, g_make_moving_average)
- Xen_wrap_any_args(g_make_moving_max_w, g_make_moving_max)
- Xen_wrap_any_args(g_make_moving_norm_w, g_make_moving_norm)
- Xen_wrap_3_optional_args(g_delay_w, g_delay)
- Xen_wrap_2_optional_args(g_delay_tick_w, g_delay_tick)
- Xen_wrap_2_optional_args(g_tap_w, g_tap)
- Xen_wrap_3_optional_args(g_notch_w, g_notch)
- Xen_wrap_3_optional_args(g_comb_w, g_comb)
- Xen_wrap_3_optional_args(g_filtered_comb_w, g_filtered_comb)
- Xen_wrap_3_optional_args(g_all_pass_w, g_all_pass)
- Xen_wrap_2_optional_args(g_moving_average_w, g_moving_average)
- Xen_wrap_2_optional_args(g_moving_max_w, g_moving_max)
- Xen_wrap_2_optional_args(g_moving_norm_w, g_moving_norm)
- Xen_wrap_1_arg(g_is_tap_w, g_is_tap)
- Xen_wrap_1_arg(g_is_delay_w, g_is_delay)
- Xen_wrap_1_arg(g_is_notch_w, g_is_notch)
- Xen_wrap_1_arg(g_is_comb_w, g_is_comb)
- Xen_wrap_1_arg(g_is_filtered_comb_w, g_is_filtered_comb)
- Xen_wrap_1_arg(g_is_all_pass_w, g_is_all_pass)
- Xen_wrap_1_arg(g_is_moving_average_w, g_is_moving_average)
- Xen_wrap_1_arg(g_is_moving_max_w, g_is_moving_max)
- Xen_wrap_1_arg(g_is_moving_norm_w, g_is_moving_norm)
-
- Xen_wrap_2_optional_args(g_ncos_w, g_ncos)
- Xen_wrap_1_arg(g_is_ncos_w, g_is_ncos)
- Xen_wrap_2_optional_args(g_nsin_w, g_nsin)
- Xen_wrap_1_arg(g_is_nsin_w, g_is_nsin)
-
- Xen_wrap_any_args(g_make_rand_w, g_make_rand)
- Xen_wrap_any_args(g_make_rand_interp_w, g_make_rand_interp)
- Xen_wrap_2_optional_args(g_rand_w, g_rand)
- Xen_wrap_2_optional_args(g_rand_interp_w, g_rand_interp)
- Xen_wrap_1_arg(g_is_rand_w, g_is_rand)
- Xen_wrap_1_arg(g_is_rand_interp_w, g_is_rand_interp)
- Xen_wrap_1_arg(g_mus_random_w, g_mus_random)
- Xen_wrap_no_args(g_mus_rand_seed_w, g_mus_rand_seed)
- Xen_wrap_1_arg(g_mus_set_rand_seed_w, g_mus_set_rand_seed)
- Xen_wrap_1_arg(g_is_table_lookup_w, g_is_table_lookup)
- Xen_wrap_any_args(g_make_table_lookup_w, g_make_table_lookup)
- Xen_wrap_2_optional_args(g_table_lookup_w, g_table_lookup)
- Xen_wrap_3_optional_args(g_partials_to_wave_w, g_partials_to_wave)
- Xen_wrap_3_optional_args(g_phase_partials_to_wave_w, g_phase_partials_to_wave)
- Xen_wrap_6_optional_args(g_make_sawtooth_wave_w, g_make_sawtooth_wave)
- Xen_wrap_2_optional_args(g_sawtooth_wave_w, g_sawtooth_wave)
- Xen_wrap_1_arg(g_is_sawtooth_wave_w, g_is_sawtooth_wave)
- Xen_wrap_6_optional_args(g_make_triangle_wave_w, g_make_triangle_wave)
- Xen_wrap_2_optional_args(g_triangle_wave_w, g_triangle_wave)
- Xen_wrap_1_arg(g_is_triangle_wave_w, g_is_triangle_wave)
- Xen_wrap_6_optional_args(g_make_square_wave_w, g_make_square_wave)
- Xen_wrap_2_optional_args(g_square_wave_w, g_square_wave)
- Xen_wrap_1_arg(g_is_square_wave_w, g_is_square_wave)
- Xen_wrap_6_optional_args(g_make_pulse_train_w, g_make_pulse_train)
- Xen_wrap_2_optional_args(g_pulse_train_w, g_pulse_train)
- Xen_wrap_1_arg(g_is_pulse_train_w, g_is_pulse_train)
-
- Xen_wrap_3_args(g_make_pulsed_env_w, g_make_pulsed_env)
- Xen_wrap_2_optional_args(g_pulsed_env_w, g_pulsed_env)
- Xen_wrap_1_arg(g_is_pulsed_env_w, g_is_pulsed_env)
-
- Xen_wrap_3_optional_args(g_asymmetric_fm_w, g_asymmetric_fm)
- Xen_wrap_1_arg(g_is_asymmetric_fm_w, g_is_asymmetric_fm)
- Xen_wrap_4_optional_args(g_make_one_zero_w, g_make_one_zero)
- Xen_wrap_2_optional_args(g_one_zero_w, g_one_zero)
- Xen_wrap_1_arg(g_is_one_zero_w, g_is_one_zero)
- Xen_wrap_4_optional_args(g_make_one_pole_w, g_make_one_pole)
- Xen_wrap_2_optional_args(g_one_pole_w, g_one_pole)
- Xen_wrap_1_arg(g_is_one_pole_w, g_is_one_pole)
- Xen_wrap_6_optional_args(g_make_two_zero_w, g_make_two_zero)
- Xen_wrap_2_optional_args(g_two_zero_w, g_two_zero)
- Xen_wrap_1_arg(g_is_two_zero_w, g_is_two_zero)
- Xen_wrap_6_optional_args(g_make_two_pole_w, g_make_two_pole)
- Xen_wrap_2_optional_args(g_two_pole_w, g_two_pole)
- Xen_wrap_1_arg(g_is_two_pole_w, g_is_two_pole)
-
- Xen_wrap_1_arg(g_is_formant_w, g_is_formant)
- Xen_wrap_4_optional_args(g_make_formant_w, g_make_formant)
- Xen_wrap_3_optional_args(g_formant_w, g_formant)
-
- Xen_wrap_2_optional_args(g_formant_bank_w, g_formant_bank)
- Xen_wrap_1_arg(g_is_formant_bank_w, g_is_formant_bank)
- Xen_wrap_2_optional_args(g_make_formant_bank_w, g_make_formant_bank)
-
- Xen_wrap_1_arg(g_is_firmant_w, g_is_firmant)
- Xen_wrap_4_optional_args(g_make_firmant_w, g_make_firmant)
- Xen_wrap_3_optional_args(g_firmant_w, g_firmant)
-
- Xen_wrap_1_arg(g_is_one_pole_all_pass_w, g_is_one_pole_all_pass)
- Xen_wrap_2_args(g_make_one_pole_all_pass_w, g_make_one_pole_all_pass)
- Xen_wrap_2_optional_args(g_one_pole_all_pass_w, g_one_pole_all_pass)
-
- Xen_wrap_2_args(g_set_formant_frequency_w, g_set_formant_frequency)
- Xen_wrap_3_args(g_set_formant_radius_and_frequency_w, g_set_formant_radius_and_frequency)
-
- Xen_wrap_5_args(g_frample_to_frample_w, g_frample_to_frample)
-
- Xen_wrap_any_args(g_make_wave_train_w, g_make_wave_train)
- Xen_wrap_2_optional_args(g_wave_train_w, g_wave_train)
- Xen_wrap_1_arg(g_is_wave_train_w, g_is_wave_train)
- Xen_wrap_any_args(g_make_polyshape_w, g_make_polyshape)
- Xen_wrap_3_optional_args(g_polyshape_w, g_polyshape)
- Xen_wrap_1_arg(g_is_polyshape_w, g_is_polyshape)
- Xen_wrap_2_optional_args(g_partials_to_polynomial_w, g_partials_to_polynomial)
- Xen_wrap_1_arg(g_normalize_partials_w, g_normalize_partials)
- Xen_wrap_2_args(g_chebyshev_t_sum_w, g_chebyshev_t_sum)
- Xen_wrap_2_args(g_chebyshev_u_sum_w, g_chebyshev_u_sum)
- Xen_wrap_3_args(g_chebyshev_tu_sum_w, g_chebyshev_tu_sum)
- Xen_wrap_any_args(g_make_polywave_w, g_make_polywave)
- Xen_wrap_2_optional_args(g_polywave_w, g_polywave)
- Xen_wrap_1_arg(g_is_polywave_w, g_is_polywave)
-
- Xen_wrap_any_args(g_make_nrxysin_w, g_make_nrxysin)
- Xen_wrap_2_optional_args(g_nrxysin_w, g_nrxysin)
- Xen_wrap_1_arg(g_is_nrxysin_w, g_is_nrxysin)
- Xen_wrap_any_args(g_make_nrxycos_w, g_make_nrxycos)
- Xen_wrap_2_optional_args(g_nrxycos_w, g_nrxycos)
- Xen_wrap_1_arg(g_is_nrxycos_w, g_is_nrxycos)
-
- Xen_wrap_any_args(g_make_rxyksin_w, g_make_rxyksin)
- Xen_wrap_2_optional_args(g_rxyksin_w, g_rxyksin)
- Xen_wrap_1_arg(g_is_rxyksin_w, g_is_rxyksin)
- Xen_wrap_any_args(g_make_rxykcos_w, g_make_rxykcos)
- Xen_wrap_2_optional_args(g_rxykcos_w, g_rxykcos)
- Xen_wrap_1_arg(g_is_rxykcos_w, g_is_rxykcos)
-
- Xen_wrap_6_optional_args(g_make_filter_w, g_make_filter)
- Xen_wrap_2_optional_args(g_filter_w, g_filter)
- Xen_wrap_1_arg(g_is_filter_w, g_is_filter)
- Xen_wrap_4_optional_args(g_make_fir_filter_w, g_make_fir_filter)
- Xen_wrap_2_args(g_make_fir_coeffs_w, g_make_fir_coeffs)
- Xen_wrap_2_optional_args(g_fir_filter_w, g_fir_filter)
- Xen_wrap_1_arg(g_is_fir_filter_w, g_is_fir_filter)
- Xen_wrap_4_optional_args(g_make_iir_filter_w, g_make_iir_filter)
- Xen_wrap_2_optional_args(g_iir_filter_w, g_iir_filter)
- Xen_wrap_1_arg(g_is_iir_filter_w, g_is_iir_filter)
- Xen_wrap_1_arg(g_mus_xcoeffs_w, g_mus_xcoeffs)
- Xen_wrap_1_arg(g_mus_ycoeffs_w, g_mus_ycoeffs)
- Xen_wrap_2_args(g_mus_xcoeff_w, g_mus_xcoeff)
- Xen_wrap_3_args(g_mus_set_xcoeff_w, g_mus_set_xcoeff)
- Xen_wrap_2_args(g_mus_ycoeff_w, g_mus_ycoeff)
- Xen_wrap_3_args(g_mus_set_ycoeff_w, g_mus_set_ycoeff)
- Xen_wrap_1_arg(g_is_env_w, g_is_env)
- Xen_wrap_1_arg(g_env_w, g_env)
- Xen_wrap_any_args(g_make_env_w, g_make_env)
- Xen_wrap_2_args(g_env_interp_w, g_env_interp)
- Xen_wrap_3_optional_args(g_envelope_interp_w, g_envelope_interp)
- Xen_wrap_2_args(g_env_any_w, g_env_any)
- Xen_wrap_1_arg(g_is_file_to_sample_w, g_is_file_to_sample)
- Xen_wrap_2_optional_args(g_make_file_to_sample_w, g_make_file_to_sample)
- Xen_wrap_3_optional_args(g_file_to_sample_w, g_file_to_sample)
- Xen_wrap_1_arg(g_is_sample_to_file_w, g_is_sample_to_file)
- Xen_wrap_5_optional_args(g_make_sample_to_file_w, g_make_sample_to_file)
- Xen_wrap_1_arg(g_continue_sample_to_file_w, g_continue_sample_to_file)
- Xen_wrap_4_args(g_sample_to_file_w, g_sample_to_file)
- Xen_wrap_2_args(g_sample_to_file_add_w, g_sample_to_file_add)
-
- Xen_wrap_1_arg(g_is_file_to_frample_w, g_is_file_to_frample)
- Xen_wrap_2_optional_args(g_make_file_to_frample_w, g_make_file_to_frample)
- Xen_wrap_3_optional_args(g_file_to_frample_w, g_file_to_frample)
- Xen_wrap_1_arg(g_continue_frample_to_file_w, g_continue_frample_to_file)
- Xen_wrap_1_arg(g_is_frample_to_file_w, g_is_frample_to_file)
- Xen_wrap_3_args(g_frample_to_file_w, g_frample_to_file)
- Xen_wrap_5_optional_args(g_make_frample_to_file_w, g_make_frample_to_file)
-
-
- Xen_wrap_1_arg(g_is_mus_input_w, g_is_mus_input)
- Xen_wrap_1_arg(g_is_mus_output_w, g_is_mus_output)
- Xen_wrap_3_args(g_in_any_w, g_in_any)
- Xen_wrap_2_args(g_ina_w, g_ina)
- Xen_wrap_2_args(g_inb_w, g_inb)
- Xen_wrap_4_optional_args(g_out_any_w, g_out_any)
- Xen_wrap_3_optional_args(g_outa_w, g_outa)
- Xen_wrap_3_optional_args(g_outb_w, g_outb)
- Xen_wrap_3_optional_args(g_outc_w, g_outc)
- Xen_wrap_3_optional_args(g_outd_w, g_outd)
- Xen_wrap_1_arg(g_mus_close_w, g_mus_close)
- Xen_wrap_no_args(g_mus_file_buffer_size_w, g_mus_file_buffer_size)
- Xen_wrap_1_arg(g_mus_set_file_buffer_size_w, g_mus_set_file_buffer_size)
- Xen_wrap_1_arg(g_is_readin_w, g_is_readin)
- Xen_wrap_1_arg(g_readin_w, g_readin)
- Xen_wrap_any_args(g_make_readin_w, g_make_readin)
- Xen_wrap_1_arg(g_mus_channel_w, g_mus_channel)
- Xen_wrap_1_arg(g_mus_interp_type_w, g_mus_interp_type)
- Xen_wrap_1_arg(g_mus_location_w, g_mus_location)
- Xen_wrap_2_args(g_mus_set_location_w, g_mus_set_location)
- Xen_wrap_1_arg(g_mus_increment_w, g_mus_increment)
- Xen_wrap_2_args(g_mus_set_increment_w, g_mus_set_increment)
- Xen_wrap_1_arg(g_mus_feedback_w, g_mus_feedback)
- Xen_wrap_2_args(g_mus_set_feedback_w, g_mus_set_feedback)
- Xen_wrap_1_arg(g_is_locsig_w, g_is_locsig)
- Xen_wrap_3_args(g_locsig_w, g_locsig)
- Xen_wrap_any_args(g_make_locsig_w, g_make_locsig)
- Xen_wrap_3_args(g_move_locsig_w, g_move_locsig)
- Xen_wrap_no_args(g_locsig_type_w, g_locsig_type)
- Xen_wrap_1_arg(g_set_locsig_type_w, g_set_locsig_type)
- Xen_wrap_1_arg(g_mus_channels_w, g_mus_channels)
- Xen_wrap_2_args(g_locsig_ref_w, g_locsig_ref)
- Xen_wrap_2_args(g_locsig_reverb_ref_w, g_locsig_reverb_ref)
- Xen_wrap_3_args(g_locsig_set_w, g_locsig_set)
- Xen_wrap_3_args(g_locsig_reverb_set_w, g_locsig_reverb_set)
- Xen_wrap_1_arg(g_is_move_sound_w, g_is_move_sound)
- Xen_wrap_3_args(g_move_sound_w, g_move_sound)
- Xen_wrap_3_optional_args(g_make_move_sound_w, g_make_move_sound)
- Xen_wrap_no_args(g_mus_clear_sincs_w, g_mus_clear_sincs)
- Xen_wrap_1_arg(g_is_src_w, g_is_src)
- Xen_wrap_3_optional_args(g_src_w, g_src)
- Xen_wrap_6_optional_args(g_make_src_w, g_make_src)
- Xen_wrap_1_arg(g_is_granulate_w, g_is_granulate)
- Xen_wrap_3_optional_args(g_granulate_w, g_granulate)
- Xen_wrap_any_args(g_make_granulate_w, g_make_granulate)
- Xen_wrap_1_arg(g_mus_ramp_w, g_mus_ramp)
- Xen_wrap_2_args(g_mus_set_ramp_w, g_mus_set_ramp)
- Xen_wrap_1_arg(g_is_convolve_w, g_is_convolve)
- Xen_wrap_2_optional_args(g_convolve_w, g_convolve)
- Xen_wrap_any_args(g_make_convolve_w, g_make_convolve)
- Xen_wrap_4_optional_args(g_convolve_files_w, g_convolve_files)
- Xen_wrap_1_arg(g_is_phase_vocoder_w, g_is_phase_vocoder)
- Xen_wrap_5_optional_args(g_phase_vocoder_w, g_phase_vocoder)
- Xen_wrap_any_args(g_make_phase_vocoder_w, g_make_phase_vocoder)
- Xen_wrap_1_arg(g_phase_vocoder_amp_increments_w, g_phase_vocoder_amp_increments)
- Xen_wrap_1_arg(g_phase_vocoder_amps_w, g_phase_vocoder_amps)
- Xen_wrap_1_arg(g_phase_vocoder_freqs_w, g_phase_vocoder_freqs)
- Xen_wrap_1_arg(g_phase_vocoder_phases_w, g_phase_vocoder_phases)
- Xen_wrap_1_arg(g_phase_vocoder_phase_increments_w, g_phase_vocoder_phase_increments)
- Xen_wrap_1_arg(g_mus_hop_w, g_mus_hop)
- Xen_wrap_2_args(g_mus_set_hop_w, g_mus_set_hop)
- Xen_wrap_4_optional_args(g_make_ssb_am_w, g_make_ssb_am)
- Xen_wrap_3_optional_args(g_ssb_am_w, g_ssb_am)
- Xen_wrap_1_arg(g_is_ssb_am_w, g_is_ssb_am)
- Xen_wrap_no_args(g_clm_table_size_w, g_clm_table_size)
- Xen_wrap_1_arg(g_set_clm_table_size_w, g_set_clm_table_size)
- Xen_wrap_no_args(g_clm_default_frequency_w, g_clm_default_frequency)
- Xen_wrap_1_arg(g_set_clm_default_frequency_w, g_set_clm_default_frequency)
- Xen_wrap_1_arg(g_is_mus_generator_w, g_is_mus_generator)
- Xen_wrap_1_arg(g_mus_frandom_w, g_mus_frandom)
- Xen_wrap_1_arg(g_mus_irandom_w, g_mus_irandom)
- Xen_wrap_4_optional_args(g_make_oscil_w, g_make_oscil)
- Xen_wrap_4_optional_args(g_make_ncos_w, g_make_ncos)
- Xen_wrap_4_optional_args(g_make_oscil_bank_w, g_make_oscil_bank)
- Xen_wrap_4_optional_args(g_make_nsin_w, g_make_nsin)
- Xen_wrap_8_optional_args(g_make_asymmetric_fm_w, g_make_asymmetric_fm)
- Xen_wrap_any_args(g_mus_file_mix_w, g_mus_file_mix)
- Xen_wrap_any_args(g_mus_file_mix_with_envs_w, g_mus_file_mix_with_envs)
- Xen_wrap_2_optional_args(g_comb_bank_w, g_comb_bank)
- Xen_wrap_1_arg(g_is_comb_bank_w, g_is_comb_bank)
- Xen_wrap_1_arg(g_make_comb_bank_w, g_make_comb_bank)
- Xen_wrap_2_optional_args(g_filtered_comb_bank_w, g_filtered_comb_bank)
- Xen_wrap_1_arg(g_is_filtered_comb_bank_w, g_is_filtered_comb_bank)
- Xen_wrap_1_arg(g_make_filtered_comb_bank_w, g_make_filtered_comb_bank)
- Xen_wrap_2_optional_args(g_all_pass_bank_w, g_all_pass_bank)
- Xen_wrap_1_arg(g_is_all_pass_bank_w, g_is_all_pass_bank)
- Xen_wrap_1_arg(g_make_all_pass_bank_w, g_make_all_pass_bank)
- Xen_wrap_1_arg(g_pink_noise_w, g_pink_noise)
- Xen_wrap_3_args(g_out_bank_w, g_out_bank)
-
- #if HAVE_SCHEME
- Xen_wrap_2_args(g_piano_noise_w, g_piano_noise)
- Xen_wrap_6_args(g_singer_filter_w, g_singer_filter)
- Xen_wrap_5_args(g_singer_nose_filter_w, g_singer_nose_filter)
- #endif
-
- #if HAVE_SCHEME
- static s7_pointer acc_clm_srate(s7_scheme *sc, s7_pointer args) {return(g_mus_set_srate(s7_cadr(args)));}
- static s7_pointer acc_clm_default_frequency(s7_scheme *sc, s7_pointer args) {return(g_set_clm_default_frequency(s7_cadr(args)));}
- static s7_pointer acc_clm_table_size(s7_scheme *sc, s7_pointer args) {return(g_set_clm_table_size(s7_cadr(args)));}
- static s7_pointer acc_mus_file_buffer_size(s7_scheme *sc, s7_pointer args) {return(g_mus_set_file_buffer_size(s7_cadr(args)));}
- static s7_pointer acc_mus_float_equal_fudge_factor(s7_scheme *sc, s7_pointer args) {return(g_mus_set_float_equal_fudge_factor(s7_cadr(args)));}
- static s7_pointer acc_mus_array_print_length(s7_scheme *sc, s7_pointer args) {return(g_mus_set_array_print_length(s7_cadr(args)));}
- #endif
-
- #if HAVE_SCHEME
- static char *mus_generator_to_readable_string(s7_scheme *sc, void *obj)
- {
- char *str;
- str = (char *)malloc(64 * sizeof(char));
- snprintf(str, 64, "#<%s>", mus_name(((mus_xen *)obj)->gen));
- return(str);
- /* we need a new function to fill this role */
- /* s7_error(sc, s7_make_symbol(sc, "io-error"), s7_list(sc, 1, s7_make_string(sc, "can't write a clm generator readably"))); */
- /* return(NULL); */
- }
- #endif
-
- static void mus_xen_init(void)
- {
- #if HAVE_SCHEME
- s7_pointer s, i, p, t, r, c, f, v, b, d, j;
-
- s7_pointer pl_rcr, pl_bt, pl_ir, pl_cc, pl_ccic, pl_ccrr, pl_fc, pl_fcif, pl_cs, pl_ff, pl_tt, pl_fffifi, pl_ffftii, pl_fffi,
- pl_fti, pl_fif, pl_fiir, pl_fttb, pl_ic, pl_rciir, pl_rcir, pl_ririt, pl_rcrr, pl_rirt, pl_riirfff, pl_rirfff, pl_rrpr,
- pl_sc, pl_sssrs, pl_tc, pl_ici, pl_i, pl_fcf, pl_dcr, pl_dr, pl_dffi, pl_dfri, pl_dirfir, pl_dc, pl_dci, pl_dcir, pl_dv,
- pl_dvir, pl_drf, pl_drc, pl_diit, pl_dit, pl_dct, pl_d, pl_djr, pl_it, pl_iti;
- #endif
-
- mus_initialize();
- current_connect_func = Xen_false;
-
- #if HAVE_SCHEME
- mus_xen_tag = s7_new_type_x(s7, "<generator>", print_mus_xen, free_mus_xen, s7_equalp_mus_xen, mark_mus_xen,
- mus_xen_apply, NULL, s7_mus_length, s7_mus_copy, NULL, NULL);
- as_needed_arglist = Xen_list_1(Xen_integer_zero);
- Xen_GC_protect(as_needed_arglist);
- s7_set_object_print_readably(mus_xen_tag, mus_generator_to_readable_string);
-
- s = s7_make_symbol(s7, "string?");
- i = s7_make_symbol(s7, "integer?");
- p = s7_make_symbol(s7, "pair?");
- t = s7_t(s7);
- r = s7_make_symbol(s7, "real?");
- c = s7_t(s7); /* s7_make_symbol(s7, "c-object?"): this should be mus-generator which should match against oscil? etc -- maybe someday... */
- f = s7_make_symbol(s7, "float-vector?");
- j = s7_make_symbol(s7, "int-vector?");
- v = s7_make_symbol(s7, "vector?");
- b = s7_make_symbol(s7, "boolean?");
- d = s7_make_symbol(s7, "float?");
-
- pl_bt = s7_make_signature(s7, 2, b, t);
- pl_rcr = s7_make_signature(s7, 3, r, c, r);
-
- pl_d = s7_make_signature(s7, 1, d);
- pl_dcr = s7_make_circular_signature(s7, 2, 3, d, c, r);
- pl_djr = s7_make_circular_signature(s7, 2, 3, d, j, r);
- pl_dct = s7_make_signature(s7, 3, d, c, t);
- pl_dci = s7_make_circular_signature(s7, 2, 3, d, c, i);
- pl_dcir = s7_make_signature(s7, 4, d, c, i, r);
- pl_dr = s7_make_circular_signature(s7, 1, 2, d, r);
- pl_dffi = s7_make_signature(s7, 4, d, f, f, i);
- pl_dfri = s7_make_signature(s7, 4, d, f, r, i);
- pl_dirfir = s7_make_signature(s7, 6, d, i, r, f, i, r);
- pl_dc = s7_make_signature(s7, 2, d, c);
- pl_dv = s7_make_signature(s7, 2, d, v);
- pl_dvir = s7_make_signature(s7, 4, d, v, i, r);
- pl_drf = s7_make_circular_signature(s7, 2, 3, d, r, f);
- pl_drc = s7_make_signature(s7, 3, d, r, c);
- pl_diit = s7_make_signature(s7, 4, d, i, i, t);
- pl_dit = s7_make_signature(s7, 3, d, i, t);
-
- pl_ir = s7_make_signature(s7, 2, i, r);
- pl_i = s7_make_circular_signature(s7, 0, 1, i);
- pl_cc = s7_make_circular_signature(s7, 1, 2, c, c);
- pl_ici = s7_make_signature(s7, 3, i, c, i);
- pl_iti = s7_make_signature(s7, 3, i, t, i);
- pl_ccic = s7_make_signature(s7, 4, c, c, i, c);
- pl_ccrr = s7_make_signature(s7, 4, c, c, r, r);
- pl_fc = s7_make_signature(s7, 2, s7_make_signature(s7, 2, f, b), c);
- pl_cs = s7_make_signature(s7, 2, c, s);
- pl_ff = s7_make_circular_signature(s7, 1, 2, f, f);
- pl_tt = s7_make_signature(s7, 2, t, t);
- pl_fcf = s7_make_signature(s7, 3, f, c, f);
- pl_fffifi = s7_make_signature(s7, 6, f, f, f, i, f, i);
- pl_ffftii = s7_make_signature(s7, 6, f, f, f, t, i, i);
- pl_fffi = s7_make_circular_signature(s7, 3, 4, f, f, f, i);
- pl_fti = s7_make_signature(s7, 3, f, t, i);
- pl_fif = s7_make_signature(s7, 3, f, i, f);
- pl_fiir = s7_make_circular_signature(s7, 3, 4, f, i, i, r);
- pl_fttb = s7_make_signature(s7, 4, f, t, t, b);
- pl_ic = s7_make_signature(s7, 2, i, c);
- pl_it = s7_make_signature(s7, 2, i, t);
- pl_rciir = s7_make_signature(s7, 5, r, c, i, i, r);
- pl_rcir = s7_make_signature(s7, 4, r, c, i, r);
- pl_ririt = s7_make_signature(s7,5, r, i, r, i, t);
- pl_rcrr = s7_make_signature(s7, 4, r, c, r, r);
- pl_rirt = s7_make_signature(s7, 4, r, i, r, t);
- pl_riirfff = s7_make_signature(s7, 7, r, i, i, r, f, f, f);
- pl_rirfff = s7_make_signature(s7, 6, r, i, r, f, f, f);
- pl_rrpr = s7_make_signature(s7, 4, r, r, p, r);
- pl_sc = s7_make_signature(s7, 2, s, c);
- pl_sssrs = s7_make_signature(s7, 5, s, s, s, r, s);
- pl_tc = s7_make_signature(s7, 2, t, c);
- pl_fcif = s7_make_signature(s7, 4, f, c, i, f);
- #else
- mus_xen_tag = Xen_make_object_type("Mus", sizeof(mus_xen));
- #endif
-
- xen_one = C_int_to_Xen_integer(1);
- Xen_GC_protect(xen_one);
- xen_minus_one = C_int_to_Xen_integer(-1);
- Xen_GC_protect(xen_minus_one);
-
- #if HAVE_FORTH
- fth_set_object_inspect(mus_xen_tag, print_mus_xen);
- fth_set_object_equal(mus_xen_tag, equalp_mus_xen);
- fth_set_object_mark(mus_xen_tag, mark_mus_xen);
- fth_set_object_free(mus_xen_tag, free_mus_xen);
- fth_set_object_apply(mus_xen_tag, Xen_procedure_cast mus_xen_apply, 0, 2, 0);
- #endif
-
- #if HAVE_RUBY
- rb_define_method(mus_xen_tag, "to_s", Xen_procedure_cast mus_xen_to_s, 0);
- rb_define_method(mus_xen_tag, "eql?", Xen_procedure_cast equalp_mus_xen, 1);
- rb_define_method(mus_xen_tag, "frequency", Xen_procedure_cast g_mus_frequency, 0);
- rb_define_method(mus_xen_tag, "frequency=", Xen_procedure_cast g_mus_set_frequency, 1);
- rb_define_method(mus_xen_tag, "phase", Xen_procedure_cast g_mus_phase, 0);
- rb_define_method(mus_xen_tag, "phase=", Xen_procedure_cast g_mus_set_phase, 1);
- rb_define_method(mus_xen_tag, "scaler", Xen_procedure_cast g_mus_scaler, 0);
- rb_define_method(mus_xen_tag, "scaler=", Xen_procedure_cast g_mus_set_scaler, 1);
- rb_define_method(mus_xen_tag, "width", Xen_procedure_cast g_mus_width, 0);
- rb_define_method(mus_xen_tag, "width=", Xen_procedure_cast g_mus_set_width, 1);
- rb_define_method(mus_xen_tag, "offset", Xen_procedure_cast g_mus_offset, 0);
- rb_define_method(mus_xen_tag, "offset=", Xen_procedure_cast g_mus_set_offset, 1);
- rb_define_method(mus_xen_tag, "reset", Xen_procedure_cast g_mus_reset, 0);
- /* rb_define_method(mus_xen_tag, "copy", Xen_procedure_cast g_mus_copy, 0); */
- rb_define_method(mus_xen_tag, "length", Xen_procedure_cast g_mus_length, 0);
- rb_define_method(mus_xen_tag, "length=", Xen_procedure_cast g_mus_set_length, 1);
- rb_define_method(mus_xen_tag, "data", Xen_procedure_cast g_mus_data, 0);
- rb_define_method(mus_xen_tag, "data=", Xen_procedure_cast g_mus_set_data, 1);
- rb_define_method(mus_xen_tag, "feedforward", Xen_procedure_cast g_mus_feedforward, 0);
- rb_define_method(mus_xen_tag, "feedforward=", Xen_procedure_cast g_mus_set_feedforward, 1);
- rb_define_method(mus_xen_tag, "feedback", Xen_procedure_cast g_mus_feedback, 0);
- rb_define_method(mus_xen_tag, "feedback=", Xen_procedure_cast g_mus_set_increment, 1);
- rb_define_method(mus_xen_tag, "order", Xen_procedure_cast g_mus_order, 0);
- rb_define_method(mus_xen_tag, "type", Xen_procedure_cast g_mus_type, 0);
- rb_define_method(mus_xen_tag, "order=", Xen_procedure_cast g_mus_set_length, 1);
- rb_define_method(mus_xen_tag, "call", Xen_procedure_cast mus_xen_apply, 2);
- rb_define_method(mus_xen_tag, "location", Xen_procedure_cast g_mus_location, 0);
- rb_define_method(mus_xen_tag, "location=", Xen_procedure_cast g_mus_set_location, 1);
- rb_define_method(mus_xen_tag, "increment", Xen_procedure_cast g_mus_increment, 0);
- rb_define_method(mus_xen_tag, "increment=", Xen_procedure_cast g_mus_set_increment, 1);
- rb_define_method(mus_xen_tag, "channels", Xen_procedure_cast g_mus_channels, 0);
- rb_define_method(mus_xen_tag, "channel", Xen_procedure_cast g_mus_channel, 0);
- rb_define_method(mus_xen_tag, "interp_type", Xen_procedure_cast g_mus_interp_type, 0);
- rb_define_method(mus_xen_tag, "xcoeffs", Xen_procedure_cast g_mus_xcoeffs, 0);
- rb_define_method(mus_xen_tag, "ycoeffs", Xen_procedure_cast g_mus_ycoeffs, 0);
- rb_define_method(mus_xen_tag, "xcoeff", Xen_procedure_cast g_mus_xcoeff, 1);
- rb_define_method(mus_xen_tag, "ycoeff", Xen_procedure_cast g_mus_ycoeff, 1);
- /*
- rb_define_method(mus_xen_tag, "xcoeff=", Xen_procedure_cast g_mus_set_xcoeff, 1);
- rb_define_method(mus_xen_tag, "ycoeff=", Xen_procedure_cast g_mus_set_ycoeff, 1);
- */
- rb_define_method(mus_xen_tag, "ramp", Xen_procedure_cast g_mus_ramp, 0);
- rb_define_method(mus_xen_tag, "ramp=", Xen_procedure_cast g_mus_set_ramp, 1);
- rb_define_method(mus_xen_tag, "hop", Xen_procedure_cast g_mus_hop, 0);
- rb_define_method(mus_xen_tag, "hop=", Xen_procedure_cast g_mus_set_hop, 1);
- rb_define_method(mus_xen_tag, "name", Xen_procedure_cast g_mus_name, 0);
- rb_define_method(mus_xen_tag, "file_name", Xen_procedure_cast g_mus_file_name, 0);
- #endif
-
- init_keywords();
-
- Xen_define_typed_dilambda(S_mus_srate, g_mus_srate_w, H_mus_srate,
- S_set S_mus_srate, g_mus_set_srate_w, 0, 0, 1, 0, pl_d, pl_dr);
- Xen_define_typed_dilambda(S_mus_float_equal_fudge_factor, g_mus_float_equal_fudge_factor_w, H_mus_float_equal_fudge_factor,
- S_set S_mus_float_equal_fudge_factor, g_mus_set_float_equal_fudge_factor_w, 0, 0, 1, 0, pl_d, pl_dr);
- Xen_define_typed_dilambda(S_mus_array_print_length, g_mus_array_print_length_w, H_mus_array_print_length,
- S_set S_mus_array_print_length, g_mus_set_array_print_length_w, 0, 0, 1, 0, pl_i, pl_i);
- Xen_define_typed_dilambda(S_clm_table_size, g_clm_table_size_w, H_clm_table_size,
- S_set S_clm_table_size, g_set_clm_table_size_w, 0, 0, 1, 0, pl_i, pl_i);
- Xen_define_typed_dilambda(S_clm_default_frequency, g_clm_default_frequency_w, H_clm_default_frequency,
- S_set S_clm_default_frequency, g_set_clm_default_frequency_w, 0, 0, 1, 0, pl_d, pl_dr);
-
- #if HAVE_SCHEME
- clm_srate_symbol = s7_define_variable(s7, "*clm-srate*", s7_make_real(s7, MUS_DEFAULT_SAMPLING_RATE));
- s7_symbol_set_access(s7, clm_srate_symbol, s7_make_function(s7, "[acc-clm-srate]", acc_clm_srate, 2, 0, false, "accessor"));
-
- clm_default_frequency_symbol = s7_define_variable(s7, "*" S_clm_default_frequency "*", s7_make_real(s7, MUS_CLM_DEFAULT_FREQUENCY));
- s7_symbol_set_documentation(s7, clm_default_frequency_symbol, "*clm-default-frequency*: the default frequency for most generators (0.0)");
- s7_symbol_set_access(s7, clm_default_frequency_symbol, s7_make_function(s7, "[acc-clm-default-frequency]", acc_clm_default_frequency, 2, 0, false, "accessor"));
-
- clm_table_size_symbol = s7_define_variable(s7, "*" S_clm_table_size "*", s7_make_integer(s7, MUS_CLM_DEFAULT_TABLE_SIZE));
- s7_symbol_set_documentation(s7, clm_table_size_symbol, "*clm-table-size*: the default table size for most generators (512)");
- s7_symbol_set_access(s7, clm_table_size_symbol, s7_make_function(s7, "[acc-clm-table-size]", acc_clm_table_size, 2, 0, false, "accessor"));
-
- mus_file_buffer_size_symbol = s7_define_variable(s7, "*clm-file-buffer-size*", s7_make_integer(s7, MUS_DEFAULT_FILE_BUFFER_SIZE));
- s7_symbol_set_access(s7, mus_file_buffer_size_symbol, s7_make_function(s7, "[acc-mus-file-buffer-size]", acc_mus_file_buffer_size, 2, 0, false, "accessor"));
-
- mus_float_equal_fudge_factor_symbol = s7_define_variable(s7, "*" S_mus_float_equal_fudge_factor "*", s7_make_real(s7, 0.0000001)); /* clm.c */
- s7_symbol_set_documentation(s7, mus_float_equal_fudge_factor_symbol, "*mus-float-equal-fudge-factor*: floating point equality fudge factor");
- s7_symbol_set_access(s7, mus_float_equal_fudge_factor_symbol, s7_make_function(s7, "[acc-mus-float-equal-fudge-factor]", acc_mus_float_equal_fudge_factor, 2, 0, false, "accessor"));
-
- mus_array_print_length_symbol = s7_define_variable(s7, "*" S_mus_array_print_length "*", s7_make_integer(s7, MUS_DEFAULT_ARRAY_PRINT_LENGTH));
- s7_symbol_set_documentation(s7, mus_array_print_length_symbol, "*mus-array-print-length*: current clm array print length (default is 8).");
- s7_symbol_set_access(s7, mus_array_print_length_symbol, s7_make_function(s7, "[acc-mus-array-print-length]", acc_mus_array_print_length, 2, 0, false, "accessor"));
- #endif
-
- Xen_define_typed_procedure(S_radians_to_hz, g_radians_to_hz_w, 1, 0, 0, H_radians_to_hz, pl_dr);
- Xen_define_typed_procedure(S_hz_to_radians, g_hz_to_radians_w, 1, 0, 0, H_hz_to_radians, pl_dr);
- Xen_define_typed_procedure(S_radians_to_degrees, g_radians_to_degrees_w, 1, 0, 0, H_radians_to_degrees, pl_dr);
- Xen_define_typed_procedure(S_degrees_to_radians, g_degrees_to_radians_w, 1, 0, 0, H_degrees_to_radians, pl_dr);
- Xen_define_typed_procedure(S_db_to_linear, g_db_to_linear_w, 1, 0, 0, H_db_to_linear, pl_dr);
- Xen_define_typed_procedure(S_linear_to_db, g_linear_to_db_w, 1, 0, 0, H_linear_to_db, pl_dr);
- Xen_define_typed_procedure(S_even_weight, g_even_weight_w, 1, 0, 0, H_even_weight, pl_dr);
- Xen_define_typed_procedure(S_odd_weight, g_odd_weight_w, 1, 0, 0, H_odd_weight, pl_dr);
- Xen_define_typed_procedure(S_even_multiple, g_even_multiple_w, 2, 0, 0, H_even_multiple, pl_dr);
- Xen_define_typed_procedure(S_odd_multiple, g_odd_multiple_w, 2, 0, 0, H_odd_multiple, pl_dr);
- Xen_define_typed_procedure(S_seconds_to_samples, g_seconds_to_samples_w, 1, 0, 0, H_seconds_to_samples, pl_ir);
- Xen_define_typed_procedure(S_samples_to_seconds, g_samples_to_seconds_w, 1, 0, 0, H_samples_to_seconds, pl_dr);
- Xen_define_typed_procedure(S_ring_modulate, g_ring_modulate_w, 2, 0, 0, H_ring_modulate, pl_dr);
- Xen_define_typed_procedure(S_amplitude_modulate, g_amplitude_modulate_w, 3, 0, 0, H_amplitude_modulate, pl_dr);
- Xen_define_typed_procedure(S_contrast_enhancement, g_contrast_enhancement_w, 1, 1, 0, H_contrast_enhancement, pl_dr);
- Xen_define_typed_procedure(S_dot_product, g_dot_product_w, 2, 1, 0, H_dot_product, pl_dffi);
- #if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
- Xen_define_typed_procedure(S_edot_product, g_edot_product_w, 2, 0, 0, H_edot_product, NULL);
- #endif
- Xen_define_typed_procedure(S_polynomial, g_polynomial_w, 2, 0, 0, H_polynomial, pl_dfri);
- Xen_define_typed_procedure(S_make_fft_window, g_make_fft_window_w, 2, 2, 0, H_make_fft_window, pl_fiir);
- Xen_define_typed_procedure(S_mus_fft, g_mus_fft_w, 2, 2, 0, H_mus_fft, pl_fffi);
- Xen_define_typed_procedure(S_spectrum, g_spectrum_w, 3, 1, 0, H_mus_spectrum, pl_ffftii);
- Xen_define_typed_procedure(S_autocorrelate, g_autocorrelate_w, 1, 0, 0, H_autocorrelate, pl_ff);
- Xen_define_typed_procedure(S_correlate, g_correlate_w, 2, 0, 0, H_correlate, pl_ff);
- Xen_define_typed_procedure(S_convolution, g_convolution_w, 2, 1, 0, H_mus_convolution, pl_fffi);
- Xen_define_typed_procedure(S_rectangular_to_polar, g_rectangular_to_polar_w, 2, 0, 0, H_rectangular_to_polar, pl_ff);
- Xen_define_typed_procedure(S_rectangular_to_magnitudes, g_rectangular_to_magnitudes_w, 2, 0, 0, H_rectangular_to_magnitudes, pl_ff);
- Xen_define_typed_procedure(S_polar_to_rectangular, g_polar_to_rectangular_w, 2, 0, 0, H_polar_to_rectangular, pl_ff);
- Xen_define_typed_procedure(S_array_interp, g_array_interp_w, 2, 1, 0, H_array_interp, pl_dfri);
- Xen_define_typed_procedure(S_mus_interpolate, g_mus_interpolate_w, 3, 2, 0, H_mus_interpolate, pl_dirfir);
- Xen_define_typed_procedure(S_mus_frandom, g_mus_frandom_w, 1, 0, 0, "random reals", pl_dr);
- Xen_define_typed_procedure(S_mus_irandom, g_mus_irandom_w, 1, 0, 0, "random integers", pl_i);
-
- Xen_define_constant(S_rectangular_window, MUS_RECTANGULAR_WINDOW, "The un-window, so to speak");
- Xen_define_constant(S_hann_window, MUS_HANN_WINDOW, "A simple raised cosine window");
- Xen_define_constant(S_welch_window, MUS_WELCH_WINDOW, "A triangular window squared");
- Xen_define_constant(S_parzen_window, MUS_PARZEN_WINDOW, "A triangular window");
- Xen_define_constant(S_bartlett_window, MUS_BARTLETT_WINDOW, "A triangular window");
- Xen_define_constant(S_bartlett_hann_window, MUS_BARTLETT_HANN_WINDOW, "A combination of the bartlett and hann windows");
- Xen_define_constant(S_bohman_window, MUS_BOHMAN_WINDOW, "A weighted cosine window");
- Xen_define_constant(S_flat_top_window, MUS_FLAT_TOP_WINDOW, "A sum of cosines window");
- Xen_define_constant(S_hamming_window, MUS_HAMMING_WINDOW, "A raised cosine");
- Xen_define_constant(S_blackman2_window, MUS_BLACKMAN2_WINDOW, "second order cosine window");
- Xen_define_constant(S_blackman3_window, MUS_BLACKMAN3_WINDOW, "third order cosine window");
- Xen_define_constant(S_blackman4_window, MUS_BLACKMAN4_WINDOW, "4th order cosine window");
- Xen_define_constant(S_blackman5_window, MUS_BLACKMAN5_WINDOW, "5th order cosine window");
- Xen_define_constant(S_blackman6_window, MUS_BLACKMAN6_WINDOW, "6th order cosine window");
- Xen_define_constant(S_blackman7_window, MUS_BLACKMAN7_WINDOW, "7th order cosine window");
- Xen_define_constant(S_blackman8_window, MUS_BLACKMAN8_WINDOW, "8th order cosine window");
- Xen_define_constant(S_blackman9_window, MUS_BLACKMAN9_WINDOW, "9th order cosine window");
- Xen_define_constant(S_blackman10_window, MUS_BLACKMAN10_WINDOW, "10th order cosine window");
- Xen_define_constant(S_exponential_window, MUS_EXPONENTIAL_WINDOW, "An inverted triangle from exp");
- Xen_define_constant(S_riemann_window, MUS_RIEMANN_WINDOW, "sinc-based window");
- Xen_define_constant(S_kaiser_window, MUS_KAISER_WINDOW, "Bessel I0 based window");
- Xen_define_constant(S_cauchy_window, MUS_CAUCHY_WINDOW, "window based on 1/(1+sqr(angle)");
- Xen_define_constant(S_poisson_window, MUS_POISSON_WINDOW, "window based on exp(-angle)");
- Xen_define_constant(S_gaussian_window, MUS_GAUSSIAN_WINDOW, "window based on exp(-sqr(angle))");
- Xen_define_constant(S_tukey_window, MUS_TUKEY_WINDOW, "window based on truncated cosine");
- Xen_define_constant(S_dolph_chebyshev_window, MUS_DOLPH_CHEBYSHEV_WINDOW, "window from inverse fft (using Chebyshev Tn)");
- Xen_define_constant(S_connes_window, MUS_CONNES_WINDOW, "triangle window squared twice");
- Xen_define_constant(S_hann_poisson_window, MUS_HANN_POISSON_WINDOW, "poisson window * hann window");
- Xen_define_constant(S_samaraki_window, MUS_SAMARAKI_WINDOW, "window from inverse fft (using Chebyshev Un)");
- Xen_define_constant(S_ultraspherical_window, MUS_ULTRASPHERICAL_WINDOW, "window from inverse fft (using Ultraspherical Cn)");
- Xen_define_constant(S_rv2_window, MUS_RV2_WINDOW, "Rife-Vincent second order window (Hann extension)");
- Xen_define_constant(S_rv3_window, MUS_RV3_WINDOW, "Rife-Vincent third order window (Hann extension)");
- Xen_define_constant(S_rv4_window, MUS_RV4_WINDOW, "Rife-Vincent 4th order window (Hann extension)");
- Xen_define_constant(S_mlt_sine_window, MUS_MLT_SINE_WINDOW, "modulated lapped transform sine window");
- Xen_define_constant(S_papoulis_window, MUS_PAPOULIS_WINDOW, "papoulise window");
- Xen_define_constant(S_dpss_window, MUS_DPSS_WINDOW, "proplate spheroidal (slepian) window");
- Xen_define_constant(S_sinc_window, MUS_SINC_WINDOW, "sinc (Lanczos) window");
-
- Xen_define_constant(S_mus_interp_linear, MUS_INTERP_LINEAR, "locsig/delay linear interpolation");
- Xen_define_constant(S_mus_interp_sinusoidal, MUS_INTERP_SINUSOIDAL, "locsig sinusoidal interpolation");
- Xen_define_constant(S_mus_interp_all_pass, MUS_INTERP_ALL_PASS, "delay interpolation");
- Xen_define_constant(S_mus_interp_lagrange, MUS_INTERP_LAGRANGE, "second order lagrange interpolation");
- Xen_define_constant(S_mus_interp_hermite, MUS_INTERP_HERMITE, "third order hermite interpolation");
- Xen_define_constant(S_mus_interp_none, MUS_INTERP_NONE, "no interpolation -- step func");
- Xen_define_constant(S_mus_interp_bezier, MUS_INTERP_BEZIER, "bezier interpolation");
-
- Xen_define_constant(S_mus_chebyshev_first_kind, MUS_CHEBYSHEV_FIRST_KIND, "Chebyshev polynomial of first kind, for " S_partials_to_polynomial);
- Xen_define_constant(S_mus_chebyshev_second_kind, MUS_CHEBYSHEV_SECOND_KIND, "Chebyshev polynomial of second kind, for " S_partials_to_polynomial);
- Xen_define_constant(S_mus_chebyshev_both_kinds, MUS_CHEBYSHEV_BOTH_KINDS, "use both Chebyshev polynomials in polywave");
-
- Xen_define_typed_procedure(S_mus_describe, g_mus_describe_w, 1, 0, 0, H_mus_describe, pl_sc);
- Xen_define_typed_procedure(S_mus_file_name, g_mus_file_name_w, 1, 0, 0, H_mus_file_name, pl_sc);
- Xen_define_typed_procedure(S_mus_reset, g_mus_reset_w, 1, 0, 0, H_mus_reset, pl_tc);
- Xen_define_typed_procedure(S_mus_copy, g_mus_copy_w, 1, 0, 0, H_mus_copy, pl_cc);
- Xen_define_typed_procedure(S_mus_run, g_mus_run_w, 1, 2, 0, H_mus_run, pl_dcr);
-
- Xen_define_typed_procedure(S_mus_name, g_mus_name_w, 1, 0, 0, H_mus_name, pl_sc);
- Xen_define_typed_dilambda(S_mus_phase, g_mus_phase_w, H_mus_phase, S_set S_mus_phase, g_mus_set_phase_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_scaler, g_mus_scaler_w, H_mus_scaler, S_set S_mus_scaler, g_mus_set_scaler_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_width, g_mus_width_w, H_mus_width, S_set S_mus_width, g_mus_set_width_w, 1, 0, 2, 0, pl_ic, pl_ici);
- Xen_define_typed_dilambda(S_mus_frequency, g_mus_frequency_w, H_mus_frequency, S_set S_mus_frequency, g_mus_set_frequency_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_length, g_mus_length_w, H_mus_length, S_set S_mus_length, g_mus_set_length_w, 1, 0, 2, 0, pl_it, pl_iti);
- Xen_define_typed_dilambda(S_mus_data, g_mus_data_w, H_mus_data, S_set S_mus_data, g_mus_set_data_w, 1, 0, 2, 0, pl_fc, pl_fcf);
- Xen_define_typed_dilambda(S_mus_xcoeff, g_mus_xcoeff_w, H_mus_xcoeff, S_set S_mus_xcoeff, g_mus_set_xcoeff_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- Xen_define_typed_dilambda(S_mus_ycoeff, g_mus_ycoeff_w, H_mus_ycoeff, S_set S_mus_ycoeff, g_mus_set_ycoeff_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- Xen_define_typed_dilambda(S_mus_offset, g_mus_offset_w, H_mus_offset, S_set S_mus_offset, g_mus_set_offset_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_mus_xcoeffs, g_mus_xcoeffs_w, 1, 0, 0, H_mus_xcoeffs, pl_fc);
- Xen_define_typed_procedure(S_mus_ycoeffs, g_mus_ycoeffs_w, 1, 0, 0, H_mus_ycoeffs, pl_fc);
- Xen_define_typed_procedure(S_is_oscil, g_is_oscil_w, 1, 0, 0, H_is_oscil, pl_bt);
- Xen_define_typed_procedure(S_oscil, g_oscil_w, 1, 2, 0, H_oscil, Q_oscil);
- Xen_define_typed_procedure(S_is_oscil_bank, g_is_oscil_bank_w, 1, 0, 0, H_is_oscil_bank, pl_bt);
- Xen_define_typed_procedure(S_oscil_bank, g_oscil_bank_w, 1, 0, 0, H_oscil_bank, pl_dc);
-
- Xen_define_typed_procedure(S_mus_apply, g_mus_apply_w, 0, 0, 1, H_mus_apply, pl_dcr);
-
- Xen_define_typed_procedure(S_make_delay, g_make_delay_w, 0, 0, 1, H_make_delay,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_delay), t));
- Xen_define_typed_procedure(S_make_comb, g_make_comb_w, 0, 0, 1, H_make_comb,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_comb), t));
- Xen_define_typed_procedure(S_make_filtered_comb, g_make_filtered_comb_w, 0, 0, 1, H_make_filtered_comb,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_filtered_comb), t));
- Xen_define_typed_procedure(S_make_notch, g_make_notch_w, 0, 0, 1, H_make_notch,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_notch), t));
- Xen_define_typed_procedure(S_make_all_pass, g_make_all_pass_w, 0, 0, 1, H_make_all_pass,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_all_pass), t));
- Xen_define_typed_procedure(S_make_moving_average, g_make_moving_average_w, 0, 0, 1, H_make_moving_average,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_moving_average), t));
- Xen_define_typed_procedure(S_make_moving_max, g_make_moving_max_w, 0, 0, 1, H_make_moving_max,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_moving_max), t));
- Xen_define_typed_procedure(S_make_moving_norm, g_make_moving_norm_w, 0, 0, 1, H_make_moving_norm,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_moving_norm), t));
- Xen_define_typed_procedure(S_delay, g_delay_w, 1, 2, 0, H_delay,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
- Xen_define_typed_procedure(S_delay_tick, g_delay_tick_w, 1, 1, 0, H_delay_tick,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
- Xen_define_typed_procedure(S_tap, g_tap_w, 1, 1, 0, H_tap,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
- Xen_define_typed_procedure(S_notch, g_notch_w, 1, 2, 0, H_notch,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_notch), r));
- Xen_define_typed_procedure(S_comb, g_comb_w, 1, 2, 0, H_comb,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_comb), r));
- Xen_define_typed_procedure(S_filtered_comb, g_filtered_comb_w, 1, 2, 0, H_filtered_comb,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_filtered_comb), r));
- Xen_define_typed_procedure(S_all_pass, g_all_pass_w, 1, 2, 0, H_all_pass,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_all_pass), r));
- Xen_define_typed_procedure(S_moving_average, g_moving_average_w, 1, 1, 0, H_moving_average,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_moving_average), r));
- Xen_define_typed_procedure(S_moving_max, g_moving_max_w, 1, 1, 0, H_moving_max,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_moving_max), r));
- Xen_define_typed_procedure(S_moving_norm, g_moving_norm_w, 1, 1, 0, H_moving_norm,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_moving_norm), r));
- Xen_define_typed_procedure(S_is_tap, g_is_tap_w, 1, 0, 0, H_is_tap, pl_bt);
- Xen_define_typed_procedure(S_is_delay, g_is_delay_w, 1, 0, 0, H_is_delay, pl_bt);
- Xen_define_typed_procedure(S_is_notch, g_is_notch_w, 1, 0, 0, H_is_notch, pl_bt);
- Xen_define_typed_procedure(S_is_comb, g_is_comb_w, 1, 0, 0, H_is_comb, pl_bt);
- Xen_define_typed_procedure(S_is_filtered_comb, g_is_filtered_comb_w, 1, 0, 0, H_is_filtered_comb, pl_bt);
- Xen_define_typed_procedure(S_is_all_pass, g_is_all_pass_w, 1, 0, 0, H_is_all_pass, pl_bt);
- Xen_define_typed_procedure(S_is_moving_average, g_is_moving_average_w, 1, 0, 0, H_is_moving_average, pl_bt);
- Xen_define_typed_procedure(S_is_moving_max, g_is_moving_max_w, 1, 0, 0, H_is_moving_max, pl_bt);
- Xen_define_typed_procedure(S_is_moving_norm, g_is_moving_norm_w, 1, 0, 0, H_is_moving_norm, pl_bt);
-
- Xen_define_typed_procedure(S_comb_bank, g_comb_bank_w, 1, 1, 0, H_comb_bank,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_comb_bank), r));
- Xen_define_typed_procedure(S_is_comb_bank, g_is_comb_bank_w, 1, 0, 0, H_is_comb_bank, pl_bt);
- Xen_define_typed_procedure(S_make_comb_bank, g_make_comb_bank_w, 1, 0, 0, H_make_comb_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_comb_bank), t));
-
- Xen_define_typed_procedure(S_filtered_comb_bank, g_filtered_comb_bank_w, 1, 1, 0, H_filtered_comb_bank,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_filtered_comb_bank), r));
- Xen_define_typed_procedure(S_is_filtered_comb_bank, g_is_filtered_comb_bank_w, 1, 0, 0, H_is_filtered_comb_bank, pl_bt);
- Xen_define_typed_procedure(S_make_filtered_comb_bank, g_make_filtered_comb_bank_w, 1, 0, 0, H_make_filtered_comb_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_filtered_comb_bank), t));
-
- Xen_define_typed_procedure(S_all_pass_bank, g_all_pass_bank_w, 1, 1, 0, H_all_pass_bank,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_all_pass_bank), r));
- Xen_define_typed_procedure(S_is_all_pass_bank, g_is_all_pass_bank_w, 1, 0, 0, H_is_all_pass_bank, pl_bt);
- Xen_define_typed_procedure(S_make_all_pass_bank, g_make_all_pass_bank_w, 1, 0, 0, H_make_all_pass_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_all_pass_bank), t));
-
- Xen_define_typed_procedure(S_pink_noise, g_pink_noise_w, 1, 0, 0, H_pink_noise, pl_dv);
-
- Xen_define_typed_procedure(S_out_bank, g_out_bank_w, 3, 0, 0, H_out_bank, pl_dvir);
-
- Xen_define_typed_dilambda(S_mus_feedback, g_mus_feedback_w, H_mus_feedback,
- S_set S_mus_feedback, g_mus_set_feedback_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_feedforward, g_mus_feedforward_w, H_mus_feedforward,
- S_set S_mus_feedforward, g_mus_set_feedforward_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_make_rand, g_make_rand_w, 0, 0, 1, H_make_rand,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rand), t));
- Xen_define_typed_procedure(S_make_rand_interp, g_make_rand_interp_w, 0, 0, 1, H_make_rand_interp,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rand_interp), t));
- #if HAVE_RUBY
- rb_define_alias(rb_mKernel, "kernel_rand", "rand");
- #endif
- Xen_define_typed_procedure(S_rand, g_rand_w, 1, 1, 0, H_rand,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rand), r));
- Xen_define_typed_procedure(S_rand_interp, g_rand_interp_w, 1, 1, 0, H_rand_interp,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rand_interp), r));
- Xen_define_typed_procedure(S_is_rand, g_is_rand_w, 1, 0, 0, H_is_rand, pl_bt);
- Xen_define_typed_procedure(S_is_rand_interp, g_is_rand_interp_w, 1, 0, 0, H_is_rand_interp, pl_bt);
- Xen_define_typed_procedure(S_mus_random, g_mus_random_w, 1, 0, 0, H_mus_random, pl_dr);
-
- Xen_define_typed_dilambda(S_mus_rand_seed, g_mus_rand_seed_w, H_mus_rand_seed,
- S_set S_mus_rand_seed, g_mus_set_rand_seed_w, 0, 0, 1, 0, pl_i, pl_i);
-
- Xen_define_typed_procedure(S_ncos, g_ncos_w, 1, 1, 0, H_ncos,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_ncos), r));
- Xen_define_typed_procedure(S_is_ncos, g_is_ncos_w, 1, 0, 0, H_is_ncos, pl_bt);
- Xen_define_typed_procedure(S_nsin, g_nsin_w, 1, 1, 0, H_nsin,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_nsin), r));
- Xen_define_typed_procedure(S_is_nsin, g_is_nsin_w, 1, 0, 0, H_is_nsin, pl_bt);
-
- Xen_define_typed_procedure(S_is_table_lookup, g_is_table_lookup_w, 1, 0, 0, H_is_table_lookup, pl_bt);
- Xen_define_typed_procedure(S_make_table_lookup, g_make_table_lookup_w, 0, 0, 1, H_make_table_lookup,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_table_lookup), t));
- Xen_define_typed_procedure(S_table_lookup, g_table_lookup_w, 1, 1, 0, H_table_lookup,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_table_lookup), r));
- Xen_define_typed_procedure(S_partials_to_wave, g_partials_to_wave_w, 1, 2, 0, H_partials_to_wave, pl_fttb);
- Xen_define_typed_procedure(S_phase_partials_to_wave, g_phase_partials_to_wave_w, 1, 2, 0, H_phase_partials_to_wave, pl_fttb);
-
-
- Xen_define_typed_procedure(S_make_sawtooth_wave, g_make_sawtooth_wave_w, 0, 6, 0, H_make_sawtooth_wave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_sawtooth_wave), t));
- Xen_define_typed_procedure(S_sawtooth_wave, g_sawtooth_wave_w, 1, 1, 0, H_sawtooth_wave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_sawtooth_wave), r));
- Xen_define_typed_procedure(S_is_sawtooth_wave, g_is_sawtooth_wave_w, 1, 0, 0, H_is_sawtooth_wave, pl_bt);
- Xen_define_typed_procedure(S_make_triangle_wave, g_make_triangle_wave_w, 0, 6, 0, H_make_triangle_wave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_triangle_wave), t));
- Xen_define_typed_procedure(S_triangle_wave, g_triangle_wave_w, 1, 1, 0, H_triangle_wave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_triangle_wave), r));
- Xen_define_typed_procedure(S_is_triangle_wave, g_is_triangle_wave_w, 1, 0, 0, H_is_triangle_wave, pl_bt);
- Xen_define_typed_procedure(S_make_square_wave, g_make_square_wave_w, 0, 6, 0, H_make_square_wave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_square_wave), t));
- Xen_define_typed_procedure(S_square_wave, g_square_wave_w, 1, 1, 0, H_square_wave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_square_wave), r));
- Xen_define_typed_procedure(S_is_square_wave, g_is_square_wave_w, 1, 0, 0, H_is_square_wave, pl_bt);
- Xen_define_typed_procedure(S_make_pulse_train, g_make_pulse_train_w, 0, 6, 0, H_make_pulse_train,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_pulse_train), t));
- Xen_define_typed_procedure(S_pulse_train, g_pulse_train_w, 1, 1, 0, H_pulse_train,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_pulse_train), r));
- Xen_define_typed_procedure(S_is_pulse_train, g_is_pulse_train_w, 1, 0, 0, H_is_pulse_train, pl_bt);
-
-
- Xen_define_typed_procedure(S_make_pulsed_env, g_make_pulsed_env_w, 3, 0, 0, H_make_pulsed_env,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_pulsed_env), t));
- Xen_define_typed_procedure(S_pulsed_env, g_pulsed_env_w, 1, 1, 0, H_pulsed_env,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_pulsed_env), r));
- Xen_define_typed_procedure(S_is_pulsed_env, g_is_pulsed_env_w, 1, 0, 0, H_is_pulsed_env, pl_bt);
-
-
- Xen_define_typed_procedure(S_asymmetric_fm, g_asymmetric_fm_w, 1, 2, 0, H_asymmetric_fm,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_asymmetric_fm), r));
- Xen_define_typed_procedure(S_is_asymmetric_fm, g_is_asymmetric_fm_w, 1, 0, 0, H_is_asymmetric_fm, pl_bt);
-
-
- Xen_define_typed_procedure(S_make_one_zero, g_make_one_zero_w, 0, 4, 0, H_make_one_zero,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_one_zero), t));
- Xen_define_typed_procedure(S_one_zero, g_one_zero_w, 1, 1, 0, H_one_zero,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_one_zero), r));
- Xen_define_typed_procedure(S_is_one_zero, g_is_one_zero_w, 1, 0, 0, H_is_one_zero, pl_bt);
- Xen_define_typed_procedure(S_make_one_pole, g_make_one_pole_w, 0, 4, 0, H_make_one_pole,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_one_pole), t));
- Xen_define_typed_procedure(S_one_pole, g_one_pole_w, 1, 1, 0, H_one_pole,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_one_pole), r));
- Xen_define_typed_procedure(S_is_one_pole, g_is_one_pole_w, 1, 0, 0, H_is_one_pole, pl_bt);
- Xen_define_typed_procedure(S_make_two_zero, g_make_two_zero_w, 0, 6, 0, H_make_two_zero,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_two_zero), t));
- Xen_define_typed_procedure(S_two_zero, g_two_zero_w, 1, 1, 0, H_two_zero,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_two_zero), r));
- Xen_define_typed_procedure(S_is_two_zero, g_is_two_zero_w, 1, 0, 0, H_is_two_zero, pl_bt);
- Xen_define_typed_procedure(S_make_two_pole, g_make_two_pole_w, 0, 6, 0, H_make_two_pole,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_two_pole), t));
- Xen_define_typed_procedure(S_two_pole, g_two_pole_w, 1, 1, 0, H_two_pole,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_two_pole), r));
- Xen_define_typed_procedure(S_is_two_pole, g_is_two_pole_w, 1, 0, 0, H_is_two_pole, pl_bt);
-
- Xen_define_typed_procedure(S_make_wave_train, g_make_wave_train_w, 0, 0, 1, H_make_wave_train,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_wave_train), t));
- Xen_define_typed_procedure(S_wave_train, g_wave_train_w, 1, 1, 0, H_wave_train,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_wave_train), r));
- Xen_define_typed_procedure(S_is_wave_train, g_is_wave_train_w, 1, 0, 0, H_is_wave_train, pl_bt);
-
- Xen_define_typed_procedure(S_is_formant, g_is_formant_w, 1, 0, 0, H_is_formant, pl_bt);
- Xen_define_typed_procedure(S_make_formant, g_make_formant_w, 0, 4, 0, H_make_formant,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_formant), t));
- Xen_define_typed_procedure(S_formant, g_formant_w, 1, 2, 0, H_formant,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_formant), r));
-
- Xen_define_typed_procedure(S_formant_bank, g_formant_bank_w, 1, 1, 0, H_formant_bank,
- s7_make_signature(s7, 3, d, s7_make_symbol(s7, S_is_formant_bank), s7_make_signature(s7, 2, r, f)));
- Xen_define_typed_procedure(S_is_formant_bank, g_is_formant_bank_w, 1, 0, 0, H_is_formant_bank, pl_bt);
- Xen_define_typed_procedure(S_make_formant_bank, g_make_formant_bank_w, 1, 1, 0, H_make_formant_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_formant_bank), t));
-
- Xen_define_typed_procedure(S_is_firmant, g_is_firmant_w, 1, 0, 0, H_is_firmant, pl_bt);
- Xen_define_typed_procedure(S_make_firmant, g_make_firmant_w, 0, 4, 0, H_make_firmant,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_firmant), t));
- Xen_define_typed_procedure(S_firmant, g_firmant_w, 1, 2, 0, H_firmant,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_firmant), r));
-
- Xen_define_typed_procedure(S_is_one_pole_all_pass, g_is_one_pole_all_pass_w, 1, 0, 0, H_is_one_pole_all_pass, pl_bt);
- Xen_define_typed_procedure(S_make_one_pole_all_pass, g_make_one_pole_all_pass_w, 2, 0, 0, H_make_one_pole_all_pass,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_one_pole_all_pass), t));
- Xen_define_typed_procedure(S_one_pole_all_pass, g_one_pole_all_pass_w, 1, 1, 0, H_one_pole_all_pass,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_one_pole_all_pass), r));
-
- Xen_define_typed_procedure(S_mus_set_formant_frequency, g_set_formant_frequency_w, 2, 0, 0, H_mus_set_formant_frequency, pl_rcr);
- Xen_define_typed_procedure(S_mus_set_formant_radius_and_frequency, g_set_formant_radius_and_frequency_w, 3, 0, 0, H_mus_set_formant_radius_and_frequency, pl_rcrr);
-
-
- Xen_define_typed_procedure(S_make_polyshape, g_make_polyshape_w, 0, 0, 1, H_make_polyshape,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_polyshape), t));
- Xen_define_typed_procedure(S_polyshape, g_polyshape_w, 1, 2, 0, H_polyshape,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_polyshape), r));
- Xen_define_typed_procedure(S_is_polyshape, g_is_polyshape_w, 1, 0, 0, H_is_polyshape, pl_bt);
- Xen_define_typed_procedure(S_partials_to_polynomial, g_partials_to_polynomial_w, 1, 1, 0, H_partials_to_polynomial, pl_fti);
- Xen_define_typed_procedure(S_normalize_partials, g_normalize_partials_w, 1, 0, 0, H_normalize_partials, pl_tt);
- Xen_define_typed_procedure(S_mus_chebyshev_t_sum, g_chebyshev_t_sum_w, 2, 0, 0, H_chebyshev_t_sum, pl_drf);
- Xen_define_typed_procedure(S_mus_chebyshev_u_sum, g_chebyshev_u_sum_w, 2, 0, 0, H_chebyshev_u_sum, pl_drf);
- Xen_define_typed_procedure(S_mus_chebyshev_tu_sum, g_chebyshev_tu_sum_w, 3, 0, 0, H_chebyshev_tu_sum, pl_drf);
- Xen_define_typed_procedure(S_make_polywave, g_make_polywave_w, 0, 0, 1, H_make_polywave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_polywave), t));
- Xen_define_typed_procedure(S_polywave, g_polywave_w, 1, 1, 0, H_polywave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_polywave), r));
- Xen_define_typed_procedure(S_is_polywave, g_is_polywave_w, 1, 0, 0, H_is_polywave, pl_bt);
-
- Xen_define_typed_procedure(S_make_nrxysin, g_make_nrxysin_w, 0, 0, 1, H_make_nrxysin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_nrxysin), t));
- Xen_define_typed_procedure(S_nrxysin, g_nrxysin_w, 1, 1, 0, H_nrxysin,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_nrxysin), r));
- Xen_define_typed_procedure(S_is_nrxysin, g_is_nrxysin_w, 1, 0, 0, H_is_nrxysin, pl_bt);
- Xen_define_typed_procedure(S_make_nrxycos, g_make_nrxycos_w, 0, 0, 1, H_make_nrxycos,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_nrxycos), t));
- Xen_define_typed_procedure(S_nrxycos, g_nrxycos_w, 1, 1, 0, H_nrxycos,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_nrxycos), r));
- Xen_define_typed_procedure(S_is_nrxycos, g_is_nrxycos_w, 1, 0, 0, H_is_nrxycos, pl_bt);
-
- Xen_define_typed_procedure(S_make_rxyksin, g_make_rxyksin_w, 0, 0, 1, H_make_rxyksin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rxyksin), t));
- Xen_define_typed_procedure(S_rxyksin, g_rxyksin_w, 1, 1, 0, H_rxyksin,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rxyksin), r));
- Xen_define_typed_procedure(S_is_rxyksin, g_is_rxyksin_w, 1, 0, 0, H_is_rxyksin, pl_bt);
- Xen_define_typed_procedure(S_make_rxykcos, g_make_rxykcos_w, 0, 0, 1, H_make_rxykcos,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rxykcos), t));
- Xen_define_typed_procedure(S_rxykcos, g_rxykcos_w, 1, 1, 0, H_rxykcos,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rxykcos), r));
- Xen_define_typed_procedure(S_is_rxykcos, g_is_rxykcos_w, 1, 0, 0, H_is_rxykcos, pl_bt);
-
-
- Xen_define_typed_procedure(S_make_filter, g_make_filter_w, 0, 6, 0, H_make_filter,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_filter), t));
- Xen_define_typed_procedure(S_filter, g_filter_w, 1, 1, 0, H_filter,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_filter), r));
- Xen_define_typed_procedure(S_is_filter, g_is_filter_w, 1, 0, 0, H_is_filter, pl_bt);
- Xen_define_typed_procedure(S_make_fir_coeffs, g_make_fir_coeffs_w, 2, 0, 0, H_make_fir_coeffs, pl_fif);
- Xen_define_typed_procedure(S_make_fir_filter, g_make_fir_filter_w, 0, 4, 0, H_make_fir_filter,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_fir_filter), t));
- Xen_define_typed_procedure(S_fir_filter, g_fir_filter_w, 1, 1, 0, H_fir_filter,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_fir_filter), r));
- Xen_define_typed_procedure(S_is_fir_filter, g_is_fir_filter_w, 1, 0, 0, H_is_fir_filter, pl_bt);
- Xen_define_typed_procedure(S_make_iir_filter, g_make_iir_filter_w, 0, 4, 0, H_make_iir_filter,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_iir_filter), t));
- Xen_define_typed_procedure(S_iir_filter, g_iir_filter_w, 1, 1, 0, H_iir_filter,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_iir_filter), r));
- Xen_define_typed_procedure(S_is_iir_filter, g_is_iir_filter_w, 1, 0, 0, H_is_iir_filter, pl_bt);
- Xen_define_typed_procedure(S_mus_order, g_mus_order_w, 1, 0, 0, H_mus_order, pl_ic);
- Xen_define_typed_procedure(S_mus_type, g_mus_type_w, 1, 0, 0, H_mus_type, pl_ic);
-
-
- Xen_define_typed_procedure(S_is_env, g_is_env_w, 1, 0, 0, H_is_env, pl_bt);
- Xen_define_typed_procedure(S_env, g_env_w, 1, 0, 0, H_env,
- s7_make_signature(s7, 2, d, s7_make_symbol(s7, S_is_env)));
- Xen_define_typed_procedure(S_make_env, g_make_env_w, 0, 0, 1, H_make_env,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_env), t));
- Xen_define_typed_procedure(S_env_interp, g_env_interp_w, 2, 0, 0, H_env_interp, pl_drc);
- Xen_define_typed_procedure(S_envelope_interp, g_envelope_interp_w, 2, 1, 0, H_envelope_interp, pl_rrpr);
- Xen_define_typed_procedure(S_env_any, g_env_any_w, 2, 0, 0, H_env_any, pl_dct);
-
- Xen_define_typed_procedure(S_is_locsig, g_is_locsig_w, 1, 0, 0, H_is_locsig, pl_bt);
- Xen_define_typed_procedure(S_locsig, g_locsig_w, 3, 0, 0, H_locsig,
- s7_make_circular_signature(s7, 2, 3, r, s7_make_symbol(s7, S_is_locsig), r));
- Xen_define_typed_procedure(S_make_locsig, g_make_locsig_w, 0, 0, 1, H_make_locsig,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_locsig), t));
- Xen_define_typed_procedure(S_move_locsig, g_move_locsig_w, 3, 0, 0, H_move_locsig, pl_ccrr);
- Xen_define_typed_procedure(S_mus_channels, g_mus_channels_w, 1, 0, 0, H_mus_channels, pl_it);
-
- #if HAVE_RUBY
- Xen_define_procedure(S_locsig_ref, g_locsig_ref_w, 2, 0, 0, H_locsig_ref);
- Xen_define_procedure(S_locsig_reverb_ref, g_locsig_reverb_ref_w, 2, 0, 0, H_locsig_reverb_ref);
- #endif
-
- Xen_define_typed_procedure(S_locsig_set, g_locsig_set_w, 3, 0, 0, H_locsig_set, pl_rcir);
-
- #if HAVE_SCHEME || HAVE_FORTH
- Xen_define_typed_dilambda(S_locsig_ref, g_locsig_ref_w, H_locsig_ref,
- S_set S_locsig_ref, g_locsig_set_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- Xen_define_typed_dilambda(S_locsig_reverb_ref, g_locsig_reverb_ref_w, H_locsig_reverb_ref,
- S_locsig_reverb_set, g_locsig_reverb_set_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- #endif
-
- Xen_define_typed_procedure(S_locsig_reverb_set, g_locsig_reverb_set_w, 3, 0, 0, H_locsig_reverb_set, pl_rcir);
- Xen_define_typed_dilambda(S_locsig_type, g_locsig_type_w, H_locsig_type,
- S_set S_locsig_type, g_set_locsig_type_w, 0, 0, 1, 0, pl_i, pl_i);
-
- Xen_define_typed_procedure(S_is_move_sound, g_is_move_sound_w, 1, 0, 0, H_is_move_sound, pl_bt);
- Xen_define_typed_procedure(S_move_sound, g_move_sound_w, 3, 0, 0, H_move_sound,
- s7_make_circular_signature(s7, 2, 3, r, s7_make_symbol(s7, S_is_move_sound), r));
- Xen_define_typed_procedure(S_make_move_sound, g_make_move_sound_w, 1, 2, 0, H_make_move_sound,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_move_sound), t));
-
- Xen_define_typed_procedure(S_is_file_to_sample, g_is_file_to_sample_w, 1, 0, 0, H_is_file_to_sample, pl_bt);
- Xen_define_typed_procedure(S_make_file_to_sample, g_make_file_to_sample_w, 1, 1, 0, H_make_file_to_sample,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_file_to_sample), t));
- Xen_define_typed_procedure(S_file_to_sample, g_file_to_sample_w, 2, 1, 0, H_file_to_sample,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_file_to_sample), i));
- Xen_define_typed_procedure(S_is_sample_to_file, g_is_sample_to_file_w, 1, 0, 0, H_is_sample_to_file, pl_bt);
- Xen_define_typed_procedure(S_make_sample_to_file, g_make_sample_to_file_w, 1, 4, 0, H_make_sample_to_file,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_sample_to_file), t));
- Xen_define_typed_procedure(S_continue_sample_to_file, g_continue_sample_to_file_w, 1, 0, 0, H_continue_sample_to_file, pl_cs);
- Xen_define_typed_procedure(S_sample_to_file, g_sample_to_file_w, 4, 0, 0, H_sample_to_file, pl_rciir);
- Xen_define_typed_procedure(S_sample_to_file_add, g_sample_to_file_add_w, 2, 0, 0, H_sample_to_file_add, pl_cc);
-
- Xen_define_typed_procedure(S_is_file_to_frample, g_is_file_to_frample_w, 1, 0, 0, H_is_file_to_frample, pl_bt);
- Xen_define_typed_procedure(S_make_file_to_frample, g_make_file_to_frample_w, 1, 1, 0, H_make_file_to_frample,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_file_to_frample), t));
- Xen_define_typed_procedure(S_file_to_frample, g_file_to_frample_w, 2, 1, 0, H_file_to_frample, pl_ccic);
- Xen_define_typed_procedure(S_continue_frample_to_file, g_continue_frample_to_file_w, 1, 0, 0, H_continue_frample_to_file, pl_cs);
- Xen_define_typed_procedure(S_is_frample_to_file, g_is_frample_to_file_w, 1, 0, 0, H_is_frample_to_file, pl_bt);
- Xen_define_typed_procedure(S_frample_to_file, g_frample_to_file_w, 3, 0, 0, H_frample_to_file, pl_fcif);
- Xen_define_typed_procedure(S_make_frample_to_file, g_make_frample_to_file_w, 1, 4, 0, H_make_frample_to_file,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_frample_to_file), t));
-
- Xen_define_typed_procedure(S_is_mus_input, g_is_mus_input_w, 1, 0, 0, H_is_mus_input, pl_bt);
- Xen_define_typed_procedure(S_is_mus_output, g_is_mus_output_w, 1, 0, 0, H_is_mus_output, pl_bt);
- Xen_define_typed_procedure(S_in_any, g_in_any_w, 3, 0, 0, H_in_any, pl_diit);
- Xen_define_typed_procedure(S_ina, g_ina_w, 2, 0, 0, H_ina, pl_dit);
- Xen_define_typed_procedure(S_inb, g_inb_w, 2, 0, 0, H_inb, pl_dit);
- Xen_define_typed_procedure(S_out_any, g_out_any_w, 3, 1, 0, H_out_any, pl_ririt);
- Xen_define_typed_procedure(S_outa, g_outa_w, 2, 1, 0, H_outa, pl_rirt);
- Xen_define_typed_procedure(S_outb, g_outb_w, 2, 1, 0, H_outb, pl_rirt);
- Xen_define_typed_procedure(S_outc, g_outc_w, 2, 1, 0, H_outc, pl_rirt);
- Xen_define_typed_procedure(S_outd, g_outd_w, 2, 1, 0, H_outd, pl_rirt);
- Xen_define_typed_procedure(S_mus_close, g_mus_close_w, 1, 0, 0, H_mus_close, pl_tc);
-
- Xen_define_typed_dilambda(S_mus_file_buffer_size, g_mus_file_buffer_size_w, H_mus_file_buffer_size,
- S_set S_mus_file_buffer_size, g_mus_set_file_buffer_size_w, 0, 0, 1, 0, pl_i, pl_i);
-
-
- Xen_define_typed_procedure(S_is_readin, g_is_readin_w, 1, 0, 0, H_is_readin, pl_bt);
- Xen_define_typed_procedure(S_readin, g_readin_w, 1, 0, 0, H_readin,
- s7_make_signature(s7, 2, d, s7_make_symbol(s7, S_is_readin)));
- Xen_define_typed_procedure(S_make_readin, g_make_readin_w, 0, 0, 1, H_make_readin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_readin), t));
- Xen_define_typed_procedure(S_mus_channel, g_mus_channel_w, 1, 0, 0, H_mus_channel, pl_ic);
- Xen_define_typed_procedure(S_mus_interp_type, g_mus_interp_type_w, 1, 0, 0, H_mus_interp_type, pl_ic);
-
- Xen_define_typed_dilambda(S_mus_location, g_mus_location_w, H_mus_location,
- S_set S_mus_location, g_mus_set_location_w, 1, 0, 2, 0, pl_ic, pl_ici);
- Xen_define_typed_dilambda(S_mus_increment, g_mus_increment_w, H_mus_increment,
- S_set S_mus_increment, g_mus_set_increment_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_is_granulate, g_is_granulate_w, 1, 0, 0, H_is_granulate, pl_bt);
- Xen_define_typed_procedure(S_granulate, g_granulate_w, 1, 2, 0, H_granulate,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_granulate), t));
- Xen_define_typed_procedure(S_make_granulate, g_make_granulate_w, 0, 0, 1, H_make_granulate,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_granulate), t));
-
- Xen_define_typed_dilambda(S_mus_ramp, g_mus_ramp_w, H_mus_ramp,
- S_set S_mus_ramp, g_mus_set_ramp_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
-
- Xen_define_typed_procedure(S_clear_sincs, g_mus_clear_sincs_w, 0, 0, 0, "clears out any sinc tables", NULL);
- Xen_define_typed_procedure(S_is_src, g_is_src_w, 1, 0, 0, H_is_src, pl_bt);
- Xen_define_typed_procedure(S_src, g_src_w, 1, 2, 0, H_src,
- s7_make_signature(s7, 4, d, s7_make_symbol(s7, S_is_src), r, t));
- Xen_define_typed_procedure(S_make_src, g_make_src_w, 0, 6, 0, H_make_src,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_src), t));
-
-
- Xen_define_typed_procedure(S_is_convolve, g_is_convolve_w, 1, 0, 0, H_is_convolve, pl_bt);
- Xen_define_typed_procedure(S_convolve, g_convolve_w, 1, 1, 0, H_convolve_gen,
- s7_make_signature(s7, 3, d, s7_make_symbol(s7, S_is_convolve), t));
- Xen_define_typed_procedure(S_make_convolve, g_make_convolve_w, 0, 0, 1, H_make_convolve,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_convolve), t));
- Xen_define_typed_procedure(S_convolve_files, g_convolve_files_w, 2, 2, 0, H_convolve_files, pl_sssrs);
-
- Xen_define_typed_procedure(S_is_phase_vocoder, g_is_phase_vocoder_w, 1, 0, 0, H_is_phase_vocoder, pl_bt);
- Xen_define_typed_procedure(S_phase_vocoder, g_phase_vocoder_w, 1, 4, 0, H_phase_vocoder,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_phase_vocoder), t));
- Xen_define_typed_procedure(S_make_phase_vocoder, g_make_phase_vocoder_w, 0, 0, 1, H_make_phase_vocoder,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_phase_vocoder), t));
- Xen_define_typed_procedure(S_phase_vocoder_amp_increments, g_phase_vocoder_amp_increments_w, 1, 0, 0, H_phase_vocoder_amp_increments, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_amps, g_phase_vocoder_amps_w, 1, 0, 0, H_phase_vocoder_amps, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_freqs, g_phase_vocoder_freqs_w, 1, 0, 0, H_phase_vocoder_freqs, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_phases, g_phase_vocoder_phases_w, 1, 0, 0, H_phase_vocoder_phases, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_phase_increments, g_phase_vocoder_phase_increments_w, 1, 0, 0, H_phase_vocoder_phase_increments, pl_fc);
-
- Xen_define_typed_dilambda(S_mus_hop, g_mus_hop_w, H_mus_hop,
- S_set S_mus_hop, g_mus_set_hop_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_make_ssb_am, g_make_ssb_am_w, 0, 4, 0, H_make_ssb_am,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_ssb_am), t));
- Xen_define_typed_procedure(S_ssb_am, g_ssb_am_w, 1, 2, 0, H_ssb_am,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_ssb_am), r));
- Xen_define_typed_procedure(S_is_ssb_am, g_is_ssb_am_w, 1, 0, 0, H_is_ssb_am, pl_bt);
-
- Xen_define_typed_procedure(S_is_mus_generator, g_is_mus_generator_w, 1, 0, 0, H_is_mus_generator, pl_bt);
-
- Xen_define_variable(S_output, clm_output, Xen_false);
- Xen_define_variable(S_reverb, clm_reverb, Xen_false);
-
- #if HAVE_SCHEME
- {
- s7_pointer clm_output_accessor, clm_reverb_accessor;
- /* these are globals in s7, so they aren't going to move */
- clm_output_slot = s7_slot(s7, clm_output);
- clm_reverb_slot = s7_slot(s7, clm_reverb);
- out_any_2 = out_any_2_to_mus_xen;
- /* these can't be safe functions */
- clm_output_accessor = s7_make_function(s7, "(set " S_output ")", g_clm_output_set, 2, 0, false, "called if " S_output " is set");
- s7_symbol_set_access(s7, s7_make_symbol(s7, S_output), clm_output_accessor);
-
- clm_reverb_accessor = s7_make_function(s7, "(set " S_reverb ")", g_clm_reverb_set, 2, 0, false, "called if " S_reverb " is set");
- s7_symbol_set_access(s7, s7_make_symbol(s7, S_reverb), clm_reverb_accessor);
- }
- #endif
-
- #if HAVE_SCHEME && (!_MSC_VER)
- Xen_define_typed_procedure(S_get_internal_real_time, g_get_internal_real_time_w, 0, 0, 0, H_get_internal_real_time, NULL);
- Xen_define_constant(S_internal_time_units_per_second, 1, "units used by " S_get_internal_real_time);
- #endif
-
- #if HAVE_SCHEME
- Xen_define_typed_procedure(S_piano_noise, g_piano_noise_w, 2, 0, 0, H_piano_noise, pl_djr);
- Xen_define_typed_procedure(S_singer_filter, g_singer_filter_w, 6, 0, 0, H_singer_filter, pl_riirfff);
- Xen_define_typed_procedure(S_singer_nose_filter, g_singer_nose_filter_w, 5, 0, 0, H_singer_nose_filter, pl_rirfff);
- #endif
-
- Xen_define_typed_procedure(S_make_oscil, g_make_oscil_w, 0, 4, 0, H_make_oscil,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_oscil), t));
- Xen_define_typed_procedure(S_make_ncos, g_make_ncos_w, 0, 4, 0, H_make_ncos,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_ncos), t));
- Xen_define_typed_procedure(S_make_oscil_bank, g_make_oscil_bank_w, 2, 2, 0, H_make_oscil_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_oscil_bank), t));
- Xen_define_typed_procedure(S_make_nsin, g_make_nsin_w, 0, 4, 0, H_make_nsin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_nsin), t));
- Xen_define_typed_procedure(S_make_asymmetric_fm, g_make_asymmetric_fm_w, 0, 8, 0, H_make_asymmetric_fm,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_asymmetric_fm), t));
-
- Xen_define_typed_procedure(S_mus_file_mix, g_mus_file_mix_w, 0, 0, 1, H_mus_file_mix, NULL);
- Xen_define_typed_procedure(S_mus_file_mix_with_envs, g_mus_file_mix_with_envs_w, 0, 0, 1, H_mus_file_mix_with_envs, NULL); /* actually 8 2 0 I think */
- Xen_define_typed_procedure(S_frample_to_frample, g_frample_to_frample_w, 5, 0, 0, H_frample_to_frample, pl_fffifi);
-
- #if HAVE_SCHEME
- init_choosers(s7);
- #endif
-
-
- /* -------- clm-print (see also snd-xen.c) -------- */
- #if (!USE_SND)
-
- #if HAVE_FORTH
- Xen_eval_C_string("<'> fth-print alias clm-print ( fmt args -- )");
- #endif
-
- #if HAVE_RUBY
- Xen_eval_C_string("def clm_print(str, *args)\n\
- $stdout.print format(str, *args)\n\
- end");
- #endif
- #endif
-
- Xen_provide_feature("clm");
- {
- char *clm_version;
- clm_version = mus_format("clm%d", MUS_VERSION);
- Xen_provide_feature(clm_version);
- free(clm_version);
- }
-
- #if HAVE_SCHEME && (!_MSC_VER)
- {
- struct timezone z0;
- gettimeofday(&overall_start_time, &z0);
- }
- #endif
- }
-
-
- void Init_sndlib(void)
- {
- mus_sndlib_xen_initialize();
- mus_vct_init();
- mus_xen_init();
-
- #if HAVE_SCHEME
- if (sizeof(mus_float_t) != sizeof(s7_double))
- fprintf(stderr, "in s7-clm, s7_double must match mus_float_t. Currently s7_double has %d bytes, but mus_float_t has %d\n",
- (int)sizeof(s7_double),
- (int)sizeof(mus_float_t));
- #endif
- }
-
- #if HAVE_SCHEME
- void s7_init_sndlib(s7_scheme *sc)
- {
- s7_xen_initialize(sc);
- Init_sndlib();
- }
- #endif
|