1 #include "snd.h"
2 #include "clm2xen.h"
3 #include "clm-strings.h"
4
5 /* collect syncd chans */
6 typedef struct {
7 sync_info *si;
8 snd_fd **sfs;
9 mus_long_t dur;
10 } sync_state;
11
12
free_sync_state(sync_state * sc)13 static void free_sync_state(sync_state *sc)
14 {
15 if (sc)
16 {
17 if (sc->si)
18 sc->si = free_sync_info(sc->si);
19 if (sc->sfs)
20 free(sc->sfs);
21 free(sc);
22 }
23 }
24
25
to_c_edit_position(chan_info * cp,Xen edpos,const char * caller,int arg_pos)26 int to_c_edit_position(chan_info *cp, Xen edpos, const char *caller, int arg_pos)
27 {
28 int pos = AT_CURRENT_EDIT_POSITION;
29 /* need to allow #f here for optargs */
30 /* also remember that there might be no extension language */
31
32 #if (!HAVE_EXTENSION_LANGUAGE)
33 return(cp->edit_ctr);
34 #endif
35
36 Xen_check_type(!Xen_is_bound(edpos) || Xen_is_integer(edpos) || Xen_is_false(edpos), edpos, arg_pos, caller, "an integer, or " PROC_FALSE);
37
38 if (Xen_is_integer(edpos))
39 pos = Xen_integer_to_C_int(edpos);
40
41 if (pos == AT_CURRENT_EDIT_POSITION)
42 return(cp->edit_ctr);
43
44 if ((pos < 0) ||
45 (pos >= cp->edit_size) ||
46 (!cp->edits[pos]))
47 Xen_error(Xen_make_error_type("no-such-edit"),
48 Xen_list_8(C_string_to_Xen_string("~A: no such edpos: ~A (from ~A), sound index: ~A (~S), chan: ~A, current edit: ~A"),
49 C_string_to_Xen_string(caller),
50 C_int_to_Xen_integer(pos),
51 edpos,
52 C_int_to_Xen_sound(cp->sound->index),
53 C_string_to_Xen_string(cp->sound->short_filename),
54 C_int_to_Xen_integer(cp->chan),
55 C_int_to_Xen_integer(cp->edit_ctr)));
56 return(pos);
57 }
58
59
to_c_edit_samples(chan_info * cp,Xen edpos,const char * caller,int arg_pos)60 mus_long_t to_c_edit_samples(chan_info *cp, Xen edpos, const char *caller, int arg_pos)
61 {
62 return(cp->edits[to_c_edit_position(cp, edpos, caller, arg_pos)]->samples);
63 }
64
65
beg_to_sample(Xen beg,const char * caller)66 mus_long_t beg_to_sample(Xen beg, const char *caller)
67 {
68 if (Xen_is_integer(beg))
69 {
70 mus_long_t start;
71 start = Xen_llong_to_C_llong(beg);
72 if (start < 0)
73 Xen_error(Xen_make_error_type("no-such-sample"),
74 Xen_list_3(C_string_to_Xen_string("~A: no such sample: ~A"), C_string_to_Xen_string(caller), beg));
75 if (start > (1LL << 34))
76 Xen_out_of_range_error(caller, 1, beg, "too large");
77 return(start);
78 }
79 return(0);
80 }
81
82
dur_to_samples(Xen dur,mus_long_t beg,chan_info * cp,int edpos,int argn,const char * caller)83 mus_long_t dur_to_samples(Xen dur, mus_long_t beg, chan_info *cp, int edpos, int argn, const char *caller)
84 {
85 if (Xen_is_integer(dur))
86 {
87 mus_long_t samps;
88 samps = Xen_llong_to_C_llong(dur);
89 if (samps < 0)
90 Xen_wrong_type_arg_error(caller, argn, dur, "a positive integer");
91 if (samps > (1LL << 34))
92 Xen_out_of_range_error(caller, argn, dur, "too large");
93 return(samps);
94 }
95 return(cp->edits[edpos]->samples - beg);
96 }
97
98
end_to_sample(Xen end,chan_info * cp,int edpos,const char * caller)99 static mus_long_t end_to_sample(Xen end, chan_info *cp, int edpos, const char *caller)
100 {
101 if (Xen_is_integer(end))
102 {
103 mus_long_t last;
104 last = Xen_llong_to_C_llong(end);
105 if (last < 0)
106 Xen_error(Xen_make_error_type("no-such-sample"),
107 Xen_list_3(C_string_to_Xen_string("~A: no such sample: ~A"), C_string_to_Xen_string(caller), end));
108 if (last > (1LL << 34))
109 Xen_out_of_range_error(caller, 2, end, "too large");
110 return(last);
111 }
112 return(cp->edits[edpos]->samples - 1);
113 }
114
115
get_sync_state_1(snd_info * sp,chan_info * cp,mus_long_t beg,bool over_selection,read_direction_t forwards,mus_long_t prebeg,Xen edpos,const char * caller,int arg_pos)116 static sync_state *get_sync_state_1(snd_info *sp, chan_info *cp, mus_long_t beg, bool over_selection,
117 read_direction_t forwards, mus_long_t prebeg, Xen edpos, const char *caller, int arg_pos)
118 {
119 /* can return NULL if over_selection and no current selection */
120 sync_info *si = NULL;
121 snd_fd **sfs = NULL;
122 chan_info *ncp;
123 int i, pos;
124 mus_long_t dur = 0, pbeg;
125 sync_state *sc;
126
127 if ((!over_selection) && (!sp)) return(NULL);
128
129 if ((!over_selection) && (sp->sync != 0))
130 {
131 si = snd_sync(sp->sync);
132 sfs = (snd_fd **)malloc(si->chans * sizeof(snd_fd *));
133 for (i = 0; i < si->chans; i++)
134 {
135 ncp = si->cps[i];
136 si->begs[i] = beg;
137 pos = to_c_edit_position(ncp, edpos, caller, arg_pos);
138 if (forwards == READ_FORWARD)
139 sfs[i] = init_sample_read_any(beg, ncp, READ_FORWARD, pos);
140 else sfs[i] = init_sample_read_any(ncp->edits[pos]->samples - 1, ncp, READ_BACKWARD, pos);
141 }
142 }
143 else
144 {
145 if (over_selection)
146 {
147 if (selection_is_active())
148 {
149 si = selection_sync();
150 dur = selection_len();
151 sfs = (snd_fd **)malloc(si->chans * sizeof(snd_fd *));
152 for (i = 0; i < si->chans; i++)
153 {
154 ncp = si->cps[i];
155 pos = to_c_edit_position(ncp, edpos, caller, arg_pos);
156 if (forwards == READ_FORWARD)
157 {
158 pbeg = si->begs[i] - prebeg;
159 if (pbeg < 0) pbeg = 0;
160 sfs[i] = init_sample_read_any(pbeg, ncp, READ_FORWARD, pos);
161 }
162 else sfs[i] = init_sample_read_any(si->begs[i] + dur - 1, ncp, READ_BACKWARD, pos);
163 }
164 }
165 else
166 {
167 snd_warning_without_format("no selection");
168 return(NULL);
169 }
170 }
171 }
172 if (!si)
173 {
174 snd_fd *sf = NULL;
175 pos = to_c_edit_position(cp, edpos, caller, arg_pos);
176 if (forwards == READ_FORWARD)
177 sf = init_sample_read_any(beg, cp, READ_FORWARD, pos);
178 else sf = init_sample_read_any(cp->edits[pos]->samples - 1, cp, READ_BACKWARD, pos);
179 if (sf)
180 {
181 si = make_simple_sync(cp, beg);
182 sfs = (snd_fd **)malloc(sizeof(snd_fd *));
183 sfs[0] = sf;
184 }
185 else return(NULL);
186 }
187 sc = (sync_state *)calloc(1, sizeof(sync_state));
188 sc->dur = dur;
189 sc->sfs = sfs;
190 sc->si = si;
191 return(sc);
192 }
193
194
get_sync_state(snd_info * sp,chan_info * cp,mus_long_t beg,bool over_selection,read_direction_t forwards,Xen edpos,const char * caller,int arg_pos)195 static sync_state *get_sync_state(snd_info *sp, chan_info *cp, mus_long_t beg, bool over_selection,
196 read_direction_t forwards, Xen edpos, const char *caller, int arg_pos)
197 {
198 return(get_sync_state_1(sp, cp, beg, over_selection, forwards, 0, edpos, caller, arg_pos));
199 }
200
201
get_sync_state_without_snd_fds(snd_info * sp,chan_info * cp,mus_long_t beg,bool over_selection)202 static sync_state *get_sync_state_without_snd_fds(snd_info *sp, chan_info *cp, mus_long_t beg, bool over_selection)
203 {
204 sync_info *si = NULL;
205 mus_long_t dur = 0;
206 sync_state *sc;
207 if ((sp->sync != 0) && (!over_selection))
208 {
209 int i;
210 si = snd_sync(sp->sync);
211 for (i = 0; i < si->chans; i++)
212 si->begs[i] = beg;
213 }
214 else
215 {
216 if (over_selection)
217 {
218 if (selection_is_active())
219 {
220 si = selection_sync();
221 dur = selection_len();
222 }
223 else
224 {
225 snd_warning_without_format("no selection");
226 return(NULL);
227 }
228 }
229 }
230 if (!si)
231 si = make_simple_sync(cp, beg);
232 sc = (sync_state *)calloc(1, sizeof(sync_state));
233 sc->dur = dur;
234 sc->si = si;
235 sc->sfs = NULL;
236 return(sc);
237 }
238
239
convolve_with_or_error(char * filename,mus_float_t amp,chan_info * cp,Xen edpos,int arg_pos)240 static char *convolve_with_or_error(char *filename, mus_float_t amp, chan_info *cp, Xen edpos, int arg_pos)
241 {
242 /* if string returned, needs to be freed */
243 /* amp == 0.0 means unnormalized, cp == NULL means current selection */
244 sync_state *sc;
245 sync_info *si;
246 snd_info *sp = NULL;
247 int ip, stop_point = 0, filter_chans;
248 mus_sample_t dataformat;
249 mus_long_t filtersize = 0, dataloc;
250 chan_info *ncp, *ucp;
251 char *origin;
252
253 if (cp)
254 {
255 sp = cp->sound;
256 ncp = cp;
257 }
258 else
259 {
260 sp = any_selected_sound();
261 if (!sp) return(NULL);
262 ncp = any_selected_channel(sp);
263 }
264
265 filter_chans = mus_sound_chans(filename);
266 if (filter_chans <= 0)
267 return(mus_format("convolve: impulse response file %s chans: %d", filename, filter_chans));
268
269 filtersize = mus_sound_samples(filename) / filter_chans;
270 if (filtersize <= 0)
271 return(mus_format("convolve: impulse response file %s is empty", filename));
272 /* if impulse response is stereo, we need to use both its channels */
273
274 dataloc = mus_sound_data_location(filename);
275 dataformat = mus_sound_sample_type(filename);
276
277 sc = get_sync_state_without_snd_fds(sp, ncp, 0, (!cp));
278 if (!sc) return(NULL);
279 si = sc->si;
280
281 #if HAVE_FORTH
282 origin = mus_format("\"%s\" %.3f %s",
283 filename, amp, (!cp) ? S_convolve_selection_with : S_convolve_with);
284 #else
285 origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%.3f",
286 to_proc_name((!cp) ? S_convolve_selection_with : S_convolve_with),
287 filename, amp);
288 #endif
289 if (!(ss->stopped_explicitly))
290 {
291 snd_info *gsp = NULL;
292 int impulse_chan = 0;
293 for (ip = 0; ip < si->chans; ip++)
294 {
295 char *ofile, *saved_chan_file;
296 io_error_t io_err;
297 bool ok = false;
298 mus_long_t filesize;
299
300 ucp = si->cps[ip];
301 if (!(is_editable(ucp))) continue;
302 sp = ucp->sound;
303 if (!(sp->active)) continue;
304 if ((ip == 0) || (sp != gsp))
305 gsp = ucp->sound;
306
307 /* ofile here = new convolved data */
308 ofile = snd_tempnam();
309
310 saved_chan_file = snd_tempnam();
311 io_err = save_channel_edits(ucp, saved_chan_file, to_c_edit_position(ucp, edpos, S_convolve_with, arg_pos));
312 if (io_err != IO_NO_ERROR)
313 {
314 if (ofile) free(ofile);
315 free_sync_state(sc);
316 return(mus_format("convolve: save chan (%s[%d]) in %s hit error: %s\n",
317 sp->short_filename, ucp->chan,
318 saved_chan_file, snd_open_strerror()));
319 }
320 else
321 {
322 int scfd;
323 scfd = mus_file_open_read(saved_chan_file);
324 if (scfd == -1)
325 {
326 if (ofile) free(ofile);
327 free_sync_state(sc);
328 return(mus_format("convolve: open saved chan (%s[%d]) file %s hit error: %s\n",
329 sp->short_filename, ucp->chan,
330 saved_chan_file, snd_open_strerror()));
331 }
332 else
333 {
334 file_info *hdr;
335 int fltfd;
336 hdr = sp->hdr;
337 snd_file_open_descriptors(scfd,
338 saved_chan_file,
339 hdr->sample_type,
340 hdr->data_location,
341 1, hdr->type); /* ??? */
342 fltfd = mus_file_open_read(filename);
343 if (fltfd == -1)
344 {
345 if (ofile) free(ofile);
346 free_sync_state(sc);
347 return(mus_format("convolve: open filter file %s hit error: %s\n",
348 filename, snd_open_strerror()));
349 }
350 else
351 {
352 snd_file_open_descriptors(fltfd,
353 filename,
354 dataformat,
355 dataloc,
356 filter_chans,
357 mus_sound_header_type(filename));
358 if (!cp)
359 filesize = selection_len();
360 else filesize = to_c_edit_samples(ucp, edpos, S_convolve_with, arg_pos);
361 if (filesize > 0)
362 {
363 int ipow;
364 mus_long_t fftsize;
365 ipow = (int)(ceil(log(filtersize + filesize) / log(2.0))) + 1;
366 fftsize = snd_mus_long_t_pow2(ipow);
367 ok = true;
368 c_convolve(ofile, amp, scfd,
369 mus_sound_data_location(saved_chan_file),
370 fltfd, dataloc, filtersize, fftsize, filter_chans, impulse_chan,
371 filtersize + filesize + 1,
372 gsp);
373 impulse_chan++;
374 if (impulse_chan >= filter_chans)
375 impulse_chan = 0;
376 }
377 if (mus_file_close(fltfd) != 0)
378 {
379 if (ofile) free(ofile);
380 free_sync_state(sc);
381 return(mus_format("convolve: close filter file %s hit error: %s\n",
382 filename, snd_io_strerror()));
383 }
384 }
385 }
386 if (mus_file_close(scfd) != 0)
387 {
388 if (ofile) free(ofile);
389 free_sync_state(sc);
390 return(mus_format("convolve: close saved chan (%s[%d]) file %s hit error: %s\n",
391 sp->short_filename, ucp->chan,
392 saved_chan_file, snd_io_strerror()));
393 }
394 }
395 snd_remove(saved_chan_file, REMOVE_FROM_CACHE);
396 free(saved_chan_file);
397
398 if (ok)
399 {
400 if (!cp)
401 {
402 delete_samples(si->begs[ip], sc->dur, ucp, ucp->edit_ctr);
403 if ((filtersize + filesize) > 0)
404 {
405 file_insert_samples(si->begs[ip], filtersize + filesize, ofile, ucp, 0, DELETE_ME, origin, ucp->edit_ctr);
406 reactivate_selection(ucp, si->begs[ip], si->begs[ip] + filtersize + filesize);
407 backup_edit_list(ucp);
408 ripple_trailing_marks(ucp, si->begs[ip], sc->dur, filtersize + filesize);
409 }
410 else snd_remove(ofile, REMOVE_FROM_CACHE);
411 update_graph(ucp);
412 }
413 else file_override_samples(filtersize + filesize, ofile, ucp, 0, DELETE_ME, origin);
414 }
415 if (ofile) free(ofile);
416 check_for_event();
417 if (ss->stopped_explicitly)
418 {
419 stop_point = ip;
420 break;
421 }
422 }
423 }
424 if (origin)
425 {
426 free(origin);
427 origin = NULL;
428 }
429 if (ss->stopped_explicitly)
430 {
431 /* clean up and undo all edits up to stop_point */
432 ss->stopped_explicitly = false;
433 for (ip = 0; ip <= stop_point; ip++)
434 {
435 ucp = si->cps[ip];
436 undo_edit(ucp, 1);
437 }
438 }
439 free_sync_state(sc);
440 return(NULL);
441 }
442
443
444 /* amplitude scaling */
445
scale_by(chan_info * cp,mus_float_t * ur_scalers,int len,bool over_selection)446 void scale_by(chan_info *cp, mus_float_t *ur_scalers, int len, bool over_selection)
447 {
448 /* if over_selection, sync to current selection, else sync to current sound */
449 /* 3-Oct-00: the scale factors are now embedded in the edit fragments */
450 sync_info *si;
451 int i, j;
452
453 if (over_selection)
454 si = selection_sync();
455 else si = sync_to_chan(cp);
456 if (!si) return;
457
458 for (i = 0, j = 0; i < si->chans; i++)
459 {
460 mus_long_t beg, framples;
461 chan_info *ncp;
462 ncp = si->cps[i];
463 if (over_selection)
464 {
465 beg = selection_beg(ncp);
466 framples = selection_end(ncp) - beg + 1;
467 }
468 else
469 {
470 beg = 0;
471 framples = current_samples(ncp);
472 }
473 scale_channel(ncp, ur_scalers[j], beg, framples, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT);
474 j++;
475 if (j >= len) j = 0;
476 }
477 free_sync_info(si);
478 }
479
480
scale_to(snd_info * sp,chan_info * cp,mus_float_t * ur_scalers,int len,bool over_selection)481 bool scale_to(snd_info *sp, chan_info *cp, mus_float_t *ur_scalers, int len, bool over_selection)
482 {
483 /* essentially the same as scale-by, but first take into account current maxamps */
484 /* here it matters if more than one arg is given -- if one, get overall maxamp */
485 /* if more than one, get successive maxamps */
486 bool scaled = false;
487 int i, chans, nlen, datum_size;
488 sync_info *si = NULL;
489 chan_info *ncp;
490 mus_float_t maxamp = -1.0, val;
491 mus_float_t *scalers;
492
493 if ((!over_selection) && (!cp)) return(false);
494 if (over_selection)
495 {
496 if (!(selection_is_active()))
497 return(false);
498 si = selection_sync();
499 sp = si->cps[0]->sound;
500 }
501 else si = sync_to_chan(cp);
502
503 datum_size = mus_bytes_per_sample((sp->hdr)->sample_type);
504 chans = si->chans;
505 scalers = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
506 if (chans < len)
507 nlen = chans;
508 else nlen = len;
509 for (i = 0; i < nlen; i++)
510 scalers[i] = ur_scalers[i];
511 if (chans > len)
512 for (i = len; i < chans; i++)
513 scalers[i] = ur_scalers[len - 1];
514
515 /* now find maxamps (special if len==1) and fixup the scalers */
516 if (len == 1)
517 {
518 if (scalers[0] != 0.0)
519 {
520 for (i = 0; i < chans; i++)
521 {
522 ncp = si->cps[i];
523 if (over_selection)
524 val = selection_maxamp(ncp);
525 else val = channel_maxamp(ncp, AT_CURRENT_EDIT_POSITION);
526 if (val > maxamp) maxamp = val;
527 }
528 if ((!(clipping(ss))) &&
529 (scalers[0] == 1.0) &&
530 (datum_size <= 2))
531 {
532 if (datum_size == 2)
533 scalers[0] = 32767.0 / 32768.0;
534 else scalers[0] = 127.0 / 128.0;
535 }
536 if (maxamp != 0.0)
537 val = scalers[0] / maxamp;
538 else val = 0.0;
539 }
540 else val = 0.0;
541 for (i = 0; i < chans; i++)
542 scalers[i] = val;
543 }
544 else
545 {
546 for (i = 0; i < chans; i++)
547 {
548 ncp = si->cps[i];
549 if (scalers[i] != 0.0)
550 {
551 if (over_selection)
552 val = selection_maxamp(ncp);
553 else val = channel_maxamp(ncp, AT_CURRENT_EDIT_POSITION);
554 if (val > maxamp) maxamp = val;
555 if (val != 0.0)
556 {
557 if ((!(clipping(ss))) &&
558 (scalers[i] == 1.0) &&
559 (datum_size <= 2))
560 {
561 if (datum_size == 2)
562 scalers[i] = 32767.0 / 32768.0;
563 else scalers[i] = 127.0 / 128.0;
564 }
565 scalers[i] /= val;
566 }
567 else scalers[i] = 0.0;
568 }
569 else maxamp = 1.0; /* turn off the maxamp check */
570 }
571 }
572
573 if (maxamp != 0.0)
574 {
575 for (i = 0; i < si->chans; i++)
576 {
577 mus_long_t beg, framples;
578 char *origin = NULL;
579 mus_float_t norm = 1.0;
580 ncp = si->cps[i];
581 if (nlen > i) norm = ur_scalers[i]; else norm = ur_scalers[0];
582 if (over_selection)
583 {
584 beg = selection_beg(ncp);
585 framples = selection_end(ncp) - beg + 1;
586 #if HAVE_FORTH
587 origin = mus_format("%.3f" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long " %s", norm, beg, framples, S_normalize_channel);
588 #else
589 origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long, to_proc_name(S_normalize_channel), norm, beg, framples);
590 #endif
591 }
592 else
593 {
594 beg = 0;
595 framples = current_samples(ncp);
596 #if HAVE_FORTH
597 origin = mus_format("%.3f 0 " PROC_FALSE " %s", norm, S_normalize_channel);
598 #else
599 origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "0" PROC_SEP PROC_FALSE, to_proc_name(S_normalize_channel), norm);
600 #endif
601 }
602 scale_channel_with_origin(ncp, scalers[i], beg, framples, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT, origin);
603 if (origin) free(origin);
604 origin = NULL;
605 }
606 scaled = true;
607 }
608
609 free(scalers);
610 free_sync_info(si);
611 return(scaled);
612 }
613
614
swap_channels(chan_info * cp0,chan_info * cp1,mus_long_t beg,mus_long_t dur,int pos0,int pos1)615 static void swap_channels(chan_info *cp0, chan_info *cp1, mus_long_t beg, mus_long_t dur, int pos0, int pos1)
616 {
617 snd_fd *c0, *c1;
618 snd_info *sp0;
619 file_info *hdr0 = NULL, *hdr1 = NULL;
620 int ofd0 = 0, ofd1 = 0, datumb = 0;
621 bool temp_file;
622 mus_long_t alloc_len;
623 mus_float_t **data0, **data1;
624 mus_float_t *idata0, *idata1;
625 bool reporting = false;
626 char *ofile0 = NULL, *ofile1 = NULL;
627 io_error_t io_err = IO_NO_ERROR;
628
629 if (dur <= 0) return;
630 if ((!(is_editable(cp0))) || (!(is_editable(cp1)))) return;
631 sp0 = cp0->sound;
632 reporting = ((sp0) && (dur > REPORTING_SIZE) && (!(cp0->squelch_update)));
633 if (reporting) start_progress_report(cp0);
634
635 if (dur > REPORTING_SIZE)
636 {
637 alloc_len = REPORTING_SIZE;
638 temp_file = true;
639 ofile0 = snd_tempnam();
640 hdr0 = make_temp_header(ofile0, snd_srate(sp0), 1, dur, (char *)S_swap_channels);
641 ofd0 = open_temp_file(ofile0, 1, hdr0, &io_err);
642 if (ofd0 == -1)
643 {
644 free_file_info(hdr0);
645 snd_error("%s " S_swap_channels " temp file %s: %s\n",
646 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
647 ofile0,
648 snd_open_strerror());
649 return;
650 }
651 datumb = mus_bytes_per_sample(hdr0->sample_type);
652 ofile1 = snd_tempnam();
653 hdr1 = make_temp_header(ofile1, snd_srate(sp0), 1, dur, (char *)S_swap_channels);
654 ofd1 = open_temp_file(ofile1, 1, hdr1, &io_err);
655 if (ofd1 == -1)
656 {
657 close_temp_file(ofile0, ofd0, hdr0->type, 0);
658 free_file_info(hdr0);
659 free_file_info(hdr1);
660 if (ofile0) free(ofile0);
661 snd_error("%s " S_swap_channels " temp file %s: %s\n",
662 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
663 ofile1,
664 snd_open_strerror());
665 return;
666 }
667 }
668 else
669 {
670 temp_file = false;
671 alloc_len = dur;
672 }
673
674 data0 = (mus_float_t **)malloc(sizeof(mus_float_t *));
675 data0[0] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
676 data1 = (mus_float_t **)malloc(sizeof(mus_float_t *));
677 data1[0] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
678 idata0 = data0[0];
679 idata1 = data1[0];
680 c0 = init_sample_read_any_with_bufsize(beg, cp0, READ_FORWARD, pos0, alloc_len);
681 c1 = init_sample_read_any_with_bufsize(beg, cp1, READ_FORWARD, pos1, alloc_len);
682
683 if (temp_file)
684 {
685 mus_long_t k;
686 ss->stopped_explicitly = false;
687 sampler_set_safe(c0, dur);
688 sampler_set_safe(c1, dur);
689 for (k = 0; k < dur; k += alloc_len)
690 {
691 int j, n, err;
692 j = dur - k;
693 if (j > alloc_len) j = alloc_len;
694
695 for (n = 0; n < j; n++)
696 {
697 idata0[j] = read_sample(c1);
698 idata1[j] = read_sample(c0);
699 }
700 mus_file_write(ofd0, 0, j - 1, 1, data0);
701 err = mus_file_write(ofd1, 0, j - 1, 1, data1);
702
703 if (err != MUS_NO_ERROR) break;
704 if (reporting)
705 {
706 progress_report(cp0, (mus_float_t)((double)k / (double)dur));
707 if (ss->stopped_explicitly) break;
708 if ((cp0->active < CHANNEL_HAS_EDIT_LIST) ||
709 (cp1->active < CHANNEL_HAS_EDIT_LIST))
710 {
711 ss->stopped_explicitly = true;
712 break;
713 }
714 }
715 }
716 close_temp_file(ofile0, ofd0, hdr0->type, dur * datumb);
717 close_temp_file(ofile1, ofd1, hdr1->type, dur * datumb);
718 free_file_info(hdr0);
719 free_file_info(hdr1);
720 if (!(ss->stopped_explicitly))
721 {
722 file_change_samples(beg, dur, ofile0, cp0, 0, DELETE_ME, S_swap_channels, cp0->edit_ctr);
723 file_change_samples(beg, dur, ofile1, cp1, 0, DELETE_ME, S_swap_channels, cp1->edit_ctr);
724 }
725 else
726 {
727 set_status(sp0, "swap interrupted", false);
728 ss->stopped_explicitly = false;
729 }
730 if (ofile0) {free(ofile0); ofile0 = NULL;}
731 if (ofile1) {free(ofile1); ofile1 = NULL;}
732 if (reporting) finish_progress_report(cp0);
733 }
734 else
735 {
736 samples_to_vct_with_reader(dur, idata0, c1);
737 samples_to_vct_with_reader(dur, idata1, c0);
738
739 change_samples(beg, dur, data0[0], cp0, S_swap_channels, cp0->edit_ctr, -1.0);
740 change_samples(beg, dur, data1[0], cp1, S_swap_channels, cp1->edit_ctr, -1.0);
741 }
742 swap_marks(cp0, cp1);
743 update_graph(cp0);
744 update_graph(cp1);
745 if (ofile0) free(ofile0);
746 if (ofile1) free(ofile1);
747 free(data0[0]);
748 free(data0);
749 free(data1[0]);
750 free(data1);
751 free_snd_fd(c0);
752 free_snd_fd(c1);
753 }
754
755
756 /* -------- reverse-channel -------- */
757
758 mus_float_t previous_sample_value_unscaled_and_unchecked(snd_fd *sf);
759 mus_float_t previous_sample_value_unscaled(snd_fd *sf);
760 mus_float_t previous_sample_value_unchecked(snd_fd *sf);
761
reverse_channel(chan_info * cp,snd_fd * sf,mus_long_t beg,mus_long_t dur,Xen edp,const char * caller,int arg_pos)762 static char *reverse_channel(chan_info *cp, snd_fd *sf, mus_long_t beg, mus_long_t dur, Xen edp, const char *caller, int arg_pos)
763 {
764 snd_info *sp;
765 peak_env_info *ep = NULL;
766 file_info *hdr = NULL;
767 int ofd = 0, datumb = 0, edpos = 0;
768 bool section = false, temp_file;
769 mus_long_t k, alloc_len;
770 char *origin = NULL;
771 mus_float_t **data;
772 mus_float_t *idata;
773 char *ofile = NULL;
774 io_error_t io_err = IO_NO_ERROR;
775
776 if ((beg < 0) || (dur <= 0)) return(NULL);
777 if (!(is_editable(cp))) return(NULL);
778 /* if last was reverse and start/end match, we could just copy preceding edlist entry, or undo/redo etc --
779 * how to tell that this is happening?
780 */
781 sp = cp->sound;
782 edpos = to_c_edit_position(cp, edp, caller, arg_pos);
783
784 if (dur > cp->edits[edpos]->samples) dur = cp->edits[edpos]->samples;
785 if (dur > REPORTING_SIZE)
786 {
787 temp_file = true;
788 alloc_len = REPORTING_SIZE;
789 ofile = snd_tempnam();
790 hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, caller);
791 ofd = open_temp_file(ofile, 1, hdr, &io_err);
792 if (ofd == -1)
793 {
794 char *str;
795 str = mus_format("%s %s temp file %s: %s\n",
796 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
797 caller, ofile,
798 snd_open_strerror());
799 if (ofile) free(ofile);
800 return(str);
801 }
802 datumb = mus_bytes_per_sample(hdr->sample_type);
803 }
804 else
805 {
806 temp_file = false;
807 alloc_len = dur;
808 }
809
810 if ((beg == 0) && (dur == cp->edits[edpos]->samples))
811 ep = peak_env_copy(cp, true, edpos); /* true -> reversed */
812 else
813 {
814 ep = peak_env_copy(cp, false, edpos);
815 if (ep)
816 {
817 int i, j, sbin, ebin;
818 /* now reverse the selection */
819 sbin = (int)ceil(beg / ep->samps_per_bin);
820 ebin = (int)floor((beg + dur) / ep->samps_per_bin);
821 if (ebin > ep->peak_env_size) ebin = ep->peak_env_size;
822 for (i = sbin, j = ebin - 1; i < j; i++, j--)
823 {
824 mus_float_t min1, max1;
825 min1 = ep->data_min[i];
826 max1 = ep->data_max[i];
827 ep->data_min[i] = ep->data_min[j];
828 ep->data_max[i] = ep->data_max[j];
829 ep->data_min[j] = min1;
830 ep->data_max[j] = max1;
831 }
832 if (sbin > 0) pick_one_bin(ep, sbin - 1, ep->samps_per_bin * (sbin - 1), cp, edpos);
833 if (ebin < ep->peak_env_size) pick_one_bin(ep, ebin, ep->samps_per_bin * ebin, cp, edpos);
834 }
835 section = true; /* only for reverse_marks below */
836 }
837
838 sampler_set_safe(sf, dur);
839 data = (mus_float_t **)malloc(sizeof(mus_float_t *));
840 data[0] = (mus_float_t *)malloc(alloc_len * sizeof(mus_float_t));
841 idata = data[0];
842
843 #if HAVE_FORTH
844 if (dur == cp->edits[edpos]->samples)
845 origin = mus_format("%" print_mus_long PROC_SEP PROC_FALSE " %s", beg, S_reverse_channel);
846 else origin = mus_format("%" print_mus_long PROC_SEP "%" print_mus_long " %s", beg, dur, S_reverse_channel);
847 #else
848 if (dur == cp->edits[edpos]->samples)
849 origin = mus_format("%s" PROC_OPEN "%" print_mus_long PROC_SEP PROC_FALSE, to_proc_name(S_reverse_channel), beg);
850 else origin = mus_format("%s" PROC_OPEN "%" print_mus_long PROC_SEP "%" print_mus_long, to_proc_name(S_reverse_channel), beg, dur);
851 #endif
852
853 if (temp_file)
854 {
855 for (k = 0; k < dur; k += alloc_len)
856 {
857 int err;
858 mus_long_t kp, kdur;
859 kdur = dur - k;
860 if (kdur > alloc_len) kdur = alloc_len;
861 for (kp = 0; kp < kdur; kp++)
862 idata[kp] = read_sample(sf);
863 err = mus_file_write(ofd, 0, kdur - 1, 1, data);
864 if (err != MUS_NO_ERROR) break;
865 }
866 close_temp_file(ofile, ofd, hdr->type, dur * datumb);
867 free_file_info(hdr);
868 file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, origin, edpos);
869 if (ofile)
870 {
871 free(ofile);
872 ofile = NULL;
873 }
874 }
875 else
876 {
877 mus_long_t n;
878 if ((sf->runf == previous_sample_value_unscaled_and_unchecked) ||
879 ((sf->runf == previous_sample_value_unscaled) &&
880 (sf->loc - sf->first >= (dur - 1))))
881 {
882 for (n = sf->loc, k = 0; k < dur; k++, n--)
883 idata[k] = sf->data[n];
884 }
885 else
886 {
887 if (sf->runf == previous_sample_value_unchecked)
888 {
889 for (n = sf->loc, k = 0; k < dur; k++, n--)
890 idata[k] = sf->data[n] * sf->fscaler;
891 }
892 else
893 {
894 /* beg is begin time of the edit, not where the reverse read starts */
895 /* independent of sf, if edpos is 0, and saved_data is available, and beg+dur < saved_data length, just use it.
896 */
897 mus_float_t **d;
898 if ((sf->runf == previous_sample_value_unscaled) &&
899 (edpos == 0) &&
900 (beg + dur <= cp->edits[0]->samples) &&
901 (d = mus_sound_saved_data(sp->filename)))
902 {
903 mus_long_t d2;
904 mus_float_t *dc;
905
906 dc = d[cp->chan];
907 if (dur & 1) d2 = dur - 1; else d2 = dur;
908 for (n = beg + dur, k = 0; k < d2; )
909 {
910 idata[k++] = dc[n--];
911 idata[k++] = dc[n--];
912 }
913 if (k < dur) idata[k] = dc[n];
914 }
915 else
916 {
917 for (k = 0; k < dur; k++)
918 idata[k] = read_sample(sf);
919 }
920 }
921 }
922 change_samples(beg, dur, idata, cp, origin, edpos, -1.0);
923 }
924 if (ep) cp->edits[cp->edit_ctr]->peak_env = ep;
925 reverse_marks(cp, (section) ? beg : -1, dur);
926 update_graph(cp);
927 free(data[0]);
928 free(data);
929 if (origin) free(origin);
930 return(NULL);
931 }
932
933
reverse_sound(chan_info * ncp,bool over_selection,Xen edpos,int arg_pos)934 void reverse_sound(chan_info *ncp, bool over_selection, Xen edpos, int arg_pos)
935 {
936 sync_state *sc;
937 sync_info *si;
938 int i, stop_point = 0;
939 snd_fd **sfs;
940 char *caller;
941 snd_info *sp;
942 chan_info *cp;
943
944 sp = ncp->sound;
945 caller = (char *)((over_selection) ? S_reverse_selection : S_reverse_sound);
946 sc = get_sync_state(sp, ncp, 0, over_selection, READ_BACKWARD, edpos, (const char *)caller, arg_pos);
947 if (!sc) return;
948 si = sc->si;
949 sfs = sc->sfs;
950
951 if (!(ss->stopped_explicitly))
952 {
953 for (i = 0; i < si->chans; i++)
954 {
955 char *errmsg = NULL;
956 mus_long_t dur;
957 cp = si->cps[i];
958 sp = cp->sound;
959 if (over_selection)
960 dur = sc->dur;
961 else dur = to_c_edit_samples(cp, edpos, caller, arg_pos);
962 if (dur == 0)
963 {
964 sfs[i] = free_snd_fd(sfs[i]);
965 continue;
966 }
967
968 errmsg = reverse_channel(cp, sfs[i], si->begs[i], dur, edpos, caller, arg_pos);
969
970 sfs[i] = free_snd_fd(sfs[i]);
971 if (errmsg)
972 {
973 snd_error_without_format(errmsg);
974 free(errmsg);
975 break;
976 }
977 if (ss->stopped_explicitly)
978 {
979 stop_point = i;
980 break;
981 }
982 }
983 }
984
985 if (ss->stopped_explicitly)
986 {
987 set_status(sp, "reverse stopped", false);
988 ss->stopped_explicitly = false;
989 for (i = 0; i <= stop_point; i++)
990 {
991 cp = si->cps[i];
992 undo_edit(cp, 1);
993 }
994 }
995 free_sync_state(sc);
996 }
997
998
999
1000
1001 /* -------- src -------- */
1002
1003 typedef struct {
1004 mus_any *gen;
1005 snd_fd *sf;
1006 mus_long_t sample;
1007 int dir;
1008 } src_state;
1009
src_input_as_needed(void * arg,int direction)1010 static mus_float_t src_input_as_needed(void *arg, int direction)
1011 {
1012 src_state *sr = (src_state *)arg;
1013 snd_fd *sf;
1014 sf = sr->sf;
1015 sr->sample++;
1016 if (direction != sr->dir)
1017 {
1018 read_sample_change_direction(sf, (direction == 1) ? READ_FORWARD : READ_BACKWARD);
1019 sr->dir = direction;
1020 }
1021 return(read_sample(sf));
1022 }
1023
1024
src_input_as_needed_unchanged(void * arg,int direction)1025 static mus_float_t src_input_as_needed_unchanged(void *arg, int direction)
1026 {
1027 src_state *sr = (src_state *)arg;
1028 sr->sample++;
1029 return(read_sample(sr->sf));
1030 }
1031
1032
read_sample_input(void * arg,int direction)1033 static mus_float_t read_sample_input(void *arg, int direction)
1034 {
1035 src_state *sr = (src_state *)arg;
1036 return(read_sample(sr->sf));
1037 }
1038
1039
make_src(mus_float_t srate,snd_fd * sf,bool src_change)1040 static src_state *make_src(mus_float_t srate, snd_fd *sf, bool src_change)
1041 {
1042 src_state *sr;
1043 if ((sinc_width(ss) > MUS_MAX_CLM_SINC_WIDTH) ||
1044 (sinc_width(ss) < 0) ||
1045 (fabs(srate) > MUS_MAX_CLM_SRC))
1046 return(NULL);
1047 sr = (src_state *)calloc(1, sizeof(src_state));
1048 sr->sf = sf;
1049 if (srate >= 0.0) sr->dir = 1; else sr->dir = -1; /* if env on src, this will be 0.0 even if env vals are < 0.0 */
1050 if (src_change)
1051 sr->gen = mus_make_src(&src_input_as_needed, srate, sinc_width(ss), (void *)sr);
1052 else sr->gen = mus_make_src(&src_input_as_needed_unchanged, srate, sinc_width(ss), (void *)sr);
1053 mus_set_increment(sr->gen, srate);
1054 sr->sample = 0;
1055 return(sr);
1056 }
1057
1058
free_src(src_state * sr)1059 static src_state *free_src(src_state *sr)
1060 {
1061 mus_free(sr->gen);
1062 free(sr);
1063 return(NULL);
1064 }
1065
1066
mus_long_t_compare(const void * a,const void * b)1067 static int mus_long_t_compare(const void *a, const void *b)
1068 {
1069 mus_long_t *m1, *m2;
1070 m1 = (mus_long_t *)a;
1071 m2 = (mus_long_t *)b;
1072 if (*m1 < *m2) return(-1);
1073 if (*m1 == *m2) return(0);
1074 return(1);
1075 }
1076
1077
1078 mus_float_t next_sample_value_unscaled_and_unchecked(snd_fd *sf);
1079
src_channel_with_error(chan_info * cp,snd_fd * sf,mus_long_t beg,mus_long_t dur,mus_float_t ratio,mus_any * egen,const char * origin,bool over_selection,bool * clm_err)1080 static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, mus_long_t dur, mus_float_t ratio, mus_any *egen,
1081 const char *origin, bool over_selection,
1082 bool *clm_err)
1083 {
1084 snd_info *sp = NULL;
1085 bool reporting = false;
1086 bool full_chan;
1087 mus_float_t **data;
1088 file_info *hdr = NULL;
1089 int j, ofd = 0, datumb = 0, err = 0;
1090 mus_long_t *old_marks = NULL, *new_marks = NULL;
1091 int cur_marks = 0;
1092 mus_long_t k;
1093 char *ofile = NULL;
1094 mus_float_t *idata;
1095 io_error_t io_err = IO_NO_ERROR;
1096 src_state *sr;
1097
1098 /* fprintf(stderr, "src: %" print_mus_long " %f %s\n", dur, ratio, origin); */
1099
1100 if ((!egen) && (sf->edit_ctr == cp->edit_ctr))
1101 {
1102 if (ratio == 1.0)
1103 return(NULL);
1104 if (ratio == -1.0)
1105 return(reverse_channel(cp, sf, beg, dur, C_int_to_Xen_integer(sf->edit_ctr), origin, 0));
1106 }
1107
1108 sp = cp->sound;
1109 if (!(is_editable(cp))) return(NULL); /* edit hook result perhaps */
1110
1111 sr = make_src(ratio, sf, egen); /* ratio is 0.0 if egen because the envelope is the srate, but it's passed as the "sr-change" arg */
1112 if (!sr)
1113 {
1114 (*clm_err) = true;
1115 return(mus_format("invalid src ratio: %f\n", ratio));
1116 }
1117 if ((egen) &&
1118 (mus_phase(egen) < 0.0))
1119 sr->dir = -1;
1120
1121 full_chan = ((beg == 0) && (dur == cp->edits[sf->edit_ctr]->samples)); /* not current_samples here! */
1122
1123 reporting = ((sp) && (dur > REPORTING_SIZE) && (!(cp->squelch_update)));
1124 if (reporting) start_progress_report(cp);
1125
1126 ofile = snd_tempnam();
1127 hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, (char *)origin);
1128 ofd = open_temp_file(ofile, 1, hdr, &io_err);
1129 if (ofd == -1)
1130 {
1131 return(mus_format("%s %s temp file %s: %s\n",
1132 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
1133 origin, ofile,
1134 snd_open_strerror()));
1135 }
1136
1137 data = (mus_float_t **)malloc(sizeof(mus_float_t *));
1138 datumb = mus_bytes_per_sample(hdr->sample_type);
1139
1140 j = 0;
1141 ss->stopped_explicitly = false;
1142
1143 if (!egen)
1144 {
1145 if ((ratio == 0.5) && (dur < (1 << 22)))
1146 {
1147 mus_long_t in_dur, swid2;
1148 mus_float_t *in_data;
1149
1150 swid2 = 2 * sinc_width(ss);
1151 in_dur = dur + 4 + swid2;
1152 in_data = (mus_float_t *)calloc(in_dur, sizeof(mus_float_t));
1153 samples_to_vct_with_reader(in_dur - swid2, (mus_float_t *)(in_data + swid2), sf);
1154 data[0] = mus_src_05(sr->gen, in_data, dur);
1155 k = dur * 2 + 1;
1156 j = k;
1157 free(in_data);
1158 }
1159 else
1160 {
1161 if ((ratio == 2.0) && (dur < (1 << 23)))
1162 {
1163 /* make and fill input data, make output data, pass mus_src_20 the input data array, new dur, and sr->gen
1164 */
1165 mus_long_t in_dur, swid2;
1166 mus_float_t *in_data;
1167
1168 swid2 = 2 * sinc_width(ss);
1169 in_dur = dur + 4 + swid2;
1170 in_data = (mus_float_t *)calloc(in_dur, sizeof(mus_float_t));
1171 samples_to_vct_with_reader(in_dur - swid2, (mus_float_t *)(in_data + swid2), sf);
1172 data[0] = mus_src_20(sr->gen, in_data, dur);
1173 k = dur / 2 + 1;
1174 if ((dur & 1) != 0) k++; /* ?? */
1175 j = k;
1176 free(in_data);
1177 }
1178 else
1179 {
1180 mus_long_t out_dur;
1181
1182 data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
1183 idata = data[0];
1184 out_dur = ceil(dur / fabs(ratio)) + 1;
1185
1186 for (k = 0; k < out_dur; k += MAX_BUFFER_SIZE)
1187 {
1188 mus_long_t kdur;
1189 kdur = out_dur - k;
1190 if (kdur > MAX_BUFFER_SIZE) kdur = MAX_BUFFER_SIZE;
1191 mus_src_to_buffer(sr->gen, &read_sample_input, idata, kdur);
1192
1193 err = mus_file_write(ofd, 0, kdur - 1, 1, data);
1194 if (err != MUS_NO_ERROR) break;
1195 if (reporting)
1196 {
1197 progress_report(cp, (mus_float_t)((double)(sr->sample) / (double)dur));
1198 if (ss->stopped_explicitly) break;
1199 if (!(sp->active))
1200 {
1201 ss->stopped_explicitly = true;
1202 break;
1203 }
1204 }
1205 }
1206 j = 0;
1207 k = out_dur;
1208 }
1209 }
1210 }
1211 else
1212 {
1213 mus_long_t next_pass;
1214 mus_long_t cur_mark_sample;
1215 int cur_mark = 0, cur_new_mark = 0;
1216 mus_float_t env_val;
1217
1218 data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
1219 idata = data[0];
1220
1221 cur_mark_sample = -1;
1222 env_val = mus_env(egen);
1223 /* envelope case -- have to go by sr->sample, not output sample counter, also check marks */
1224
1225 if ((cp->edits[cp->edit_ctr]->marks) &&
1226 (cp->edits[cp->edit_ctr]->mark_ctr >= 0))
1227 {
1228 int m;
1229 mark **mps;
1230 mps = cp->edits[cp->edit_ctr]->marks;
1231 cur_marks = cp->edits[cp->edit_ctr]->mark_ctr + 1;
1232 new_marks = (mus_long_t *)malloc(cur_marks * sizeof(mus_long_t));
1233 old_marks = (mus_long_t *)malloc(cur_marks * sizeof(mus_long_t));
1234 for (m = 0; m < cur_marks; m++)
1235 {
1236 mus_long_t pos;
1237 pos = mark_sample(mps[m]);
1238 new_marks[m] = -1;
1239 if ((env_val >= 0.0) ||
1240 (pos < beg) ||
1241 (pos > (beg + dur)))
1242 old_marks[m] = pos;
1243 else
1244 {
1245 old_marks[m] = (dur - pos - 1) + beg; /* moving backwards, so flip marks */
1246 cur_new_mark = m;
1247 }
1248 }
1249 if ((env_val < 0.0) && (cur_marks > 1))
1250 qsort((void *)old_marks, cur_marks, sizeof(mus_long_t), mus_long_t_compare);
1251 for (m = 0; m < cur_marks; m++)
1252 if (old_marks[m] > beg)
1253 {
1254 cur_mark_sample = old_marks[m];
1255 cur_mark = m;
1256 if ((env_val >= 0.0) || (cur_marks <= 1))
1257 cur_new_mark = m;
1258 break;
1259 }
1260 }
1261 next_pass = sr->sample;
1262 for (k = 0; sr->sample < dur; k++)
1263 {
1264 idata[j] = ((mus_src(sr->gen, env_val, &src_input_as_needed)));
1265 j++;
1266 if (j == MAX_BUFFER_SIZE)
1267 {
1268 err = mus_file_write(ofd, 0, j - 1, 1, data);
1269 j = 0;
1270 if (err != MUS_NO_ERROR) break;
1271 if (reporting)
1272 {
1273 progress_report(cp, (mus_float_t)((double)(sr->sample) / (double)dur));
1274 if (ss->stopped_explicitly) break;
1275 if (!(sp->active))
1276 {
1277 ss->stopped_explicitly = true;
1278 break;
1279 }
1280 }
1281 }
1282 if (next_pass != sr->sample) /* tick env forward dependent on sr->sample */
1283 {
1284 mus_long_t jj, idiff;
1285 idiff = sr->sample - next_pass;
1286 next_pass = sr->sample;
1287 if ((new_marks) &&
1288 (cur_mark_sample != -1) &&
1289 (next_pass >= (cur_mark_sample - beg)))
1290 {
1291 /* not '==' because sr->sample can be incremented by more than 1 */
1292 new_marks[cur_new_mark] = k + beg;
1293 cur_mark++;
1294 if (env_val >= 0.0) cur_new_mark++; else cur_new_mark--;
1295 if (cur_mark < cur_marks)
1296 cur_mark_sample = old_marks[cur_mark];
1297 else cur_mark_sample = -1;
1298 }
1299 env_val = mus_env(egen);
1300 for (jj = 1; jj < idiff; jj++)
1301 env_val = mus_env(egen);
1302 }
1303 }
1304 }
1305
1306 if (reporting) finish_progress_report(cp);
1307 free_src(sr);
1308 if ((!(ss->stopped_explicitly)) && (j > 0))
1309 mus_file_write(ofd, 0, j - 1, 1, data);
1310
1311 close_temp_file(ofile, ofd, hdr->type, k * datumb);
1312 free_file_info(hdr);
1313
1314 if (!(ss->stopped_explicitly))
1315 {
1316 char *new_origin = NULL;
1317 /* egen null -> use ratio, else env, if dur=samples #f */
1318 if (!egen)
1319 {
1320
1321 #if HAVE_FORTH
1322 if (dur == cp->edits[sf->edit_ctr]->samples)
1323 new_origin = mus_format("%.4f" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE " %s", ratio, beg, S_src_channel);
1324 else new_origin = mus_format("%.4f" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long " %s", ratio, beg, dur, S_src_channel);
1325 #else
1326 if (dur == cp->edits[sf->edit_ctr]->samples)
1327 new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), ratio, beg);
1328 else new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long, to_proc_name(S_src_channel), ratio, beg, dur);
1329 #endif
1330 }
1331 else
1332 {
1333 mus_float_t base;
1334 char *envstr;
1335 env *newe;
1336 base = mus_increment(egen);
1337 newe = make_envelope_with_offset_and_scaler(mus_data(egen), mus_env_breakpoints(egen) * 2, mus_offset(egen), mus_scaler(egen));
1338 envstr = env_to_string(newe);
1339
1340 #if HAVE_FORTH
1341 if (base == 1.0)
1342 {
1343 if (dur == cp->edits[sf->edit_ctr]->samples)
1344 new_origin = mus_format("%s" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE " %s", envstr, beg, S_src_channel);
1345 else new_origin = mus_format("%s" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long " %s", envstr, beg, dur, S_src_channel);
1346 }
1347 else new_origin = mus_format("%s :base %.4f :end %" print_mus_long " %s %" print_mus_long PROC_SEP "%" print_mus_long " %s", envstr, base, dur, S_make_env, beg, dur, S_src_channel);
1348 #else
1349 if (base == 1.0)
1350 {
1351 if (dur == cp->edits[sf->edit_ctr]->samples)
1352 new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), envstr, beg);
1353 else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long, to_proc_name(S_src_channel), envstr, beg, dur);
1354 }
1355 else new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%" print_mus_long ")" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long,
1356 to_proc_name(S_make_env), to_proc_name(S_src_channel), envstr, base, dur, beg, dur);
1357 #endif
1358 if (envstr) free(envstr);
1359 free_env(newe);
1360 }
1361
1362 if (!full_chan)
1363 {
1364 /* here we need delete followed by insert since dur is probably different */
1365 if (k == dur)
1366 file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, new_origin, sf->edit_ctr);
1367 else
1368 {
1369 delete_samples(beg, dur, cp, sf->edit_ctr);
1370 file_insert_samples(beg, k, ofile, cp, 0, DELETE_ME, new_origin, cp->edit_ctr);
1371 if (over_selection)
1372 reactivate_selection(cp, beg, beg + k); /* backwards compatibility */
1373 backup_edit_list(cp);
1374 ripple_marks(cp, 0, 0);
1375 }
1376 update_graph(cp);
1377 }
1378 else file_override_samples(k, ofile, cp, 0, DELETE_ME, new_origin);
1379
1380 if (new_origin) free(new_origin);
1381
1382 /* not file_change_samples because that would not necessarily change the current file length */
1383 if (cp->edits[cp->edit_ctr]->marks)
1384 {
1385 if (!egen)
1386 src_marks(cp, ratio, dur, k, beg, full_chan);
1387 else
1388 {
1389 if (new_marks)
1390 reset_marks(cp, cur_marks, new_marks, beg + dur, (k - dur), full_chan);
1391 }
1392 }
1393
1394 /* if possible, copy the previous amp env and change the samps_per_bin to reflect ratio */
1395 if ((full_chan) && (!egen) && /* just ratio -- egen is freed by caller */
1396 (!(cp->edits[cp->edit_ctr]->peak_env))) /* can this happen? */
1397 {
1398 peak_env_info *ep;
1399 ep = cp->edits[sf->edit_ctr]->peak_env; /* previous peak env (sf is freed by caller) */
1400 if (ep)
1401 {
1402 mus_float_t bratio;
1403 int iratio;
1404 bratio = ep->samps_per_bin / fabs(ratio);
1405 iratio = (int)bratio;
1406 if ((bratio - iratio) < .001)
1407 {
1408 peak_env_info *new_ep;
1409 new_ep = copy_peak_env_info(ep, (ratio < 0.0)); /* might return NULL if ep but not ep->completed */
1410 if (new_ep)
1411 {
1412 new_ep->samps_per_bin = iratio;
1413 cp->edits[cp->edit_ctr]->peak_env = new_ep;
1414 }
1415 }
1416 }
1417 }
1418
1419 update_graph(cp);
1420 }
1421 else
1422 {
1423 set_status(sp, "src interrupted", false);
1424 /* should we remove the temp file here? */
1425 ss->stopped_explicitly = false;
1426 }
1427
1428 if (old_marks) free(old_marks);
1429 old_marks = NULL;
1430 if (new_marks) free(new_marks);
1431 new_marks = NULL;
1432 free(ofile);
1433 ofile = NULL;
1434 free(data[0]);
1435 free(data);
1436 return(NULL);
1437 }
1438
1439
src_env_or_num(chan_info * cp,env * e,mus_float_t ratio,bool just_num,const char * origin,bool over_selection,mus_any * gen,Xen edpos,int arg_pos)1440 void src_env_or_num(chan_info *cp, env *e, mus_float_t ratio, bool just_num,
1441 const char *origin, bool over_selection, mus_any *gen, Xen edpos, int arg_pos)
1442 {
1443 snd_info *sp = NULL;
1444 sync_state *sc;
1445 sync_info *si;
1446 snd_fd **sfs;
1447 int i;
1448 mus_long_t scdur;
1449 int stop_point = 0;
1450 char *errmsg = NULL;
1451
1452 if ((!just_num) && (!e) && (!gen)) return;
1453 if ((just_num) && (ratio == 0.0)) return;
1454
1455 /* get envelope or src ratio */
1456 sp = cp->sound;
1457 /* get current syncd chans */
1458 sc = get_sync_state(sp, cp, 0, over_selection,
1459 (ratio < 0.0) ? READ_BACKWARD : READ_FORWARD, /* 0->beg, 0->over_selection (ratio = 0.0 if from enved) */
1460 edpos,
1461 origin, arg_pos);
1462 if (!sc) return;
1463 si = sc->si;
1464 sfs = sc->sfs;
1465 scdur = sc->dur;
1466
1467 if (!(ss->stopped_explicitly))
1468 {
1469 for (i = 0; i < si->chans; i++)
1470 {
1471 mus_long_t dur;
1472 mus_any *egen = NULL;
1473 bool clm_err = false;
1474 cp = si->cps[i];
1475 if (scdur == 0)
1476 dur = to_c_edit_samples(cp, edpos, origin, arg_pos);
1477 else dur = scdur;
1478 if (dur == 0)
1479 {
1480 sfs[i] = free_snd_fd(sfs[i]);
1481 continue;
1482 }
1483 if (!just_num)
1484 {
1485 if (e)
1486 egen = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, dur - 1, NULL);
1487 else egen = gen;
1488 if (egen) ratio = 0.0; /* added 14-Mar-01 otherwise the envelope is an offset? */
1489 }
1490 errmsg = src_channel_with_error(cp, sfs[i], si->begs[i], dur, ratio, egen, origin, over_selection, &clm_err);
1491 if (egen)
1492 {
1493 if (e)
1494 mus_free(egen);
1495 else mus_reset(gen);
1496 }
1497 if (errmsg) break;
1498 if (ss->stopped_explicitly)
1499 {
1500 stop_point = i;
1501 break;
1502 }
1503 }
1504 }
1505 if (ss->stopped_explicitly)
1506 {
1507 /* clean up and undo all edits up to stop_point */
1508 ss->stopped_explicitly = false;
1509 for (i = 0; i <= stop_point; i++)
1510 {
1511 cp = si->cps[i];
1512 undo_edit(cp, 1);
1513 }
1514 }
1515 for (i = 0; i < si->chans; i++)
1516 free_snd_fd(sfs[i]);
1517 free_sync_state(sc);
1518 if (errmsg)
1519 snd_error_without_format(errmsg);
1520 }
1521
1522
input_as_needed(void * arg,int dir)1523 static mus_float_t input_as_needed(void *arg, int dir)
1524 {
1525 return(mus_readin((mus_any *)arg));
1526 }
1527
1528
src_file(const char * file,double ratio)1529 void src_file(const char *file, double ratio)
1530 {
1531 mus_any **rds, **srcs;
1532 char *temp_out;
1533 const char *comment;
1534 int k, chan, chans, width, out_fd, buffer_size;
1535 mus_sample_t sample_type;
1536 mus_header_t header_type;
1537 mus_long_t samp, old_samps, new_samps;
1538 mus_float_t old_srate, new_srate;
1539 mus_float_t **obufs;
1540
1541 old_srate = mus_srate();
1542 new_srate = mus_sound_srate(file); /* need have no connection with previous CLM srate setting */
1543 mus_set_srate(new_srate);
1544
1545 chans = mus_sound_chans(file);
1546 sample_type = mus_sound_sample_type(file);
1547 header_type = mus_sound_header_type(file);
1548 comment = mus_sound_comment(file);
1549 buffer_size = mus_file_buffer_size();
1550 old_samps = mus_sound_framples(file);
1551 new_samps = old_samps / ratio; /* old-srate/new-srate in-coming */
1552
1553 width = sinc_width(ss);
1554 if (width < 32) width = 32;
1555
1556 temp_out = snd_tempnam();
1557 out_fd = mus_sound_open_output(temp_out, new_srate, chans, sample_type, header_type, comment);
1558
1559 srcs = (mus_any **)malloc(chans * sizeof(mus_any *));
1560 rds = (mus_any **)malloc(chans * sizeof(mus_any *));
1561 obufs = (mus_float_t **)malloc(chans * sizeof(mus_float_t *));
1562
1563 for (chan = 0; chan < chans; chan++)
1564 {
1565 rds[chan] = mus_make_readin(file, chan, 0, 1);
1566 srcs[chan] = mus_make_src(NULL, ratio, width, (void *)rds[chan]);
1567 obufs[chan] = (mus_float_t *)malloc(buffer_size * sizeof(mus_float_t));
1568 }
1569
1570 for (k = 0, samp = 0; samp < new_samps; samp++)
1571 {
1572 for (chan = 0; chan < chans; chan++)
1573 obufs[chan][k] = (mus_src(srcs[chan], 0.0, &input_as_needed));
1574 k++;
1575 if (k == buffer_size)
1576 {
1577 mus_sound_write(out_fd, 0, buffer_size - 1, chans, obufs);
1578 k = 0;
1579 }
1580 }
1581 if (k > 0)
1582 mus_sound_write(out_fd, 0, k - 1, chans, obufs);
1583
1584 mus_sound_close_output(out_fd, new_samps * chans * mus_bytes_per_sample(sample_type));
1585 mus_sound_forget(file);
1586
1587 for (chan = 0; chan < chans; chan++)
1588 {
1589 free(obufs[chan]);
1590 mus_free(srcs[chan]);
1591 mus_free(rds[chan]);
1592 }
1593 free(obufs);
1594 free(srcs);
1595 free(rds);
1596
1597 move_file(temp_out, file);
1598 free(temp_out);
1599 mus_set_srate(old_srate);
1600 }
1601
1602
1603 /* FIR filtering */
1604
get_filter_coeffs(int order,env * e)1605 static mus_float_t *get_filter_coeffs(int order, env *e)
1606 {
1607 /* interpret e as frequency response */
1608 mus_float_t *a = NULL, *fdata;
1609 if (!e) return(NULL);
1610
1611 /* get the frequency envelope and design the FIR filter */
1612 fdata = sample_linear_env(e, order);
1613 if (!fdata) return(NULL);
1614 a = (mus_float_t *)calloc(order + 1, sizeof(mus_float_t));
1615
1616 mus_make_fir_coeffs(order, fdata, a);
1617
1618 free(fdata);
1619 return(a);
1620 }
1621
1622
display_frequency_response(env * e,axis_info * ap,graphics_context * gax,int order,bool dBing)1623 void display_frequency_response(env *e, axis_info *ap, graphics_context *gax, int order, bool dBing)
1624 {
1625 /* not cp->min_dB here -- this is sound panel related which refers to ss->min_dB */
1626 mus_float_t *coeffs = NULL;
1627 int height, width, i, pts, x1, y1;
1628 mus_float_t samps_per_pixel, invpts, resp, pix;
1629 int fsize, j;
1630 mus_float_t step, fx;
1631 mus_float_t *rl, *im;
1632
1633 if (order & 1) order++;
1634
1635 height = (ap->y_axis_y1 - ap->y_axis_y0);
1636 width = (ap->x_axis_x1 - ap->x_axis_x0);
1637 pts = order * 4;
1638 if (pts > width) pts = width;
1639 if (pts <= 0) pts = 1;
1640 invpts = 1.0 / (mus_float_t)pts;
1641 samps_per_pixel = (mus_float_t)(ap->x_axis_x1 - ap->x_axis_x0) * invpts;
1642
1643 coeffs = get_filter_coeffs(order, e);
1644 if (!coeffs) return;
1645
1646 fsize = 2 * snd_to_int_pow2((pts > order) ? pts : order); /* *2 for 1/2 frqs */
1647 rl = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
1648 im = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
1649 for (i = 0, j = order - 1; i < order / 2; i++, j -= 2) rl[j] = coeffs[i]; /* by 2 from 1 for 1/2 bins */
1650
1651 mus_fft(rl, im, fsize, -1);
1652
1653 resp = 2 * rl[0];
1654 if (dBing)
1655 y1 = (int)(ap->y_axis_y0 + (min_dB(ss) - in_dB(min_dB(ss), ss->lin_dB, resp)) * height / min_dB(ss));
1656 else y1 = (int)(ap->y_axis_y0 + resp * height);
1657 x1 = ap->x_axis_x0;
1658 step = (mus_float_t)(fsize - 1) / (4 * (mus_float_t)pts); /* fsize-1 since we got 1 already, *4 due to double size fft */
1659 for (i = 1, pix = x1, fx = step;
1660 i < pts;
1661 i++, pix += samps_per_pixel, fx += step)
1662 {
1663 int fxi, x0, y0;
1664 x0 = x1;
1665 y0 = y1;
1666 x1 = (int)(pix);
1667 fxi = (int)fx;
1668 resp = 2 * (rl[fxi] + (fx - fxi) * (rl[fxi + 1] - rl[fxi]));
1669 if (resp < 0.0) resp = -resp;
1670 if (dBing)
1671 y1 = (int)(ap->y_axis_y0 + (min_dB(ss) - in_dB(min_dB(ss), ss->lin_dB, resp)) * height / min_dB(ss));
1672 else y1 = (int)(ap->y_axis_y0 + resp * height);
1673 draw_line(gax, x0, y0, x1, y1);
1674 }
1675
1676 free(rl);
1677 free(im);
1678 free(coeffs);
1679 }
1680
1681
clm_channel(chan_info * cp,mus_any * gen,mus_long_t beg,mus_long_t dur,int edpos,mus_long_t overlap,const char * origin)1682 static char *clm_channel(chan_info *cp, mus_any *gen, mus_long_t beg, mus_long_t dur, int edpos, mus_long_t overlap, const char *origin)
1683 {
1684 /* calls gen over cp[beg for dur] data, replacing. */
1685 snd_info *sp;
1686 file_info *hdr = NULL;
1687 int j = 0, ofd = 0, datumb = 0;
1688 bool temp_file;
1689 mus_long_t k, alloc_len;
1690 mus_float_t **data;
1691 mus_float_t *idata;
1692 char *ofile = NULL;
1693 snd_fd *sf;
1694 mus_float_t (*runf)(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
1695
1696 if ((beg < 0) || ((dur + overlap) <= 0)) return(NULL);
1697 sp = cp->sound;
1698 if (!(is_editable(cp))) return(NULL);
1699
1700 sf = init_sample_read_any(beg, cp, READ_FORWARD, edpos);
1701 if (!sf)
1702 return(mus_format("%s can't read %s[%d] channel data!", S_clm_channel, sp->short_filename, cp->chan));
1703 runf = mus_run_function(gen);
1704
1705 if ((dur + overlap) > REPORTING_SIZE)
1706 {
1707 io_error_t io_err = IO_NO_ERROR;
1708 alloc_len = REPORTING_SIZE;
1709 temp_file = true;
1710 ofile = snd_tempnam();
1711 hdr = make_temp_header(ofile, snd_srate(sp), 1, dur + overlap, S_clm_channel);
1712 ofd = open_temp_file(ofile, 1, hdr, &io_err);
1713 if (ofd == -1)
1714 {
1715 free_snd_fd(sf);
1716 return(mus_format("%s %s temp file %s: %s\n",
1717 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
1718 S_clm_channel, ofile,
1719 snd_open_strerror()));
1720 }
1721 datumb = mus_bytes_per_sample(hdr->sample_type);
1722 }
1723 else
1724 {
1725 temp_file = false;
1726 alloc_len = dur + overlap;
1727 }
1728
1729 data = (mus_float_t **)malloc(sizeof(mus_float_t *));
1730 data[0] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
1731 idata = data[0];
1732
1733 if (temp_file)
1734 {
1735 sampler_set_safe(sf, dur);
1736 for (k = 0; k < dur; k += alloc_len)
1737 {
1738 int n, err;
1739 j = dur - k;
1740 if (j > alloc_len) j = alloc_len;
1741
1742 for (n = 0; n < j; n++)
1743 idata[n] = runf(gen, read_sample(sf), 0.0);
1744
1745 err = mus_file_write(ofd, 0, j - 1, 1, data);
1746 j = 0;
1747 if (err != MUS_NO_ERROR) break;
1748 }
1749 }
1750 else
1751 {
1752 mus_float_t (*runf1)(mus_any *gen, mus_float_t arg);
1753 samples_to_vct_with_reader(dur, idata, sf);
1754
1755 runf1 = mus_run1_function(gen);
1756 if (runf1)
1757 {
1758 for (k = 0; k < dur; k++)
1759 idata[k] = runf1(gen, idata[k]);
1760 }
1761 else
1762 {
1763 for (k = 0; k < dur; k++)
1764 idata[k] = runf(gen, idata[k], 0.0);
1765 }
1766 j = (int)dur;
1767 }
1768
1769 if (overlap > 0)
1770 {
1771 snd_fd *fd;
1772 fd = init_sample_read_any_with_bufsize(beg + dur, cp, READ_FORWARD, edpos, overlap);
1773 for (k = 0; k < overlap; k++)
1774 idata[j++] = runf(gen, 0.0, 0.0) + read_sample(fd);
1775 free_snd_fd(fd);
1776 dur += overlap;
1777 }
1778
1779 free_snd_fd(sf);
1780
1781 if (temp_file)
1782 {
1783 if (j > 0) mus_file_write(ofd, 0, j - 1, 1, data);
1784 close_temp_file(ofile, ofd, hdr->type, dur * datumb);
1785 free_file_info(hdr);
1786 file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, origin, edpos);
1787 if (ofile)
1788 {
1789 free(ofile);
1790 ofile = NULL;
1791 }
1792 }
1793 else
1794 {
1795 if (dur > 0)
1796 change_samples(beg, dur, idata, cp, origin, edpos, -1.0);
1797 }
1798 update_graph(cp);
1799 free(data[0]);
1800 free(data);
1801 return(NULL);
1802 }
1803
1804 #define TWO_30 1073741824
1805 #define MAX_SINGLE_FFT_SIZE 1048576
1806
convolve_next_sample(void * ptr,int dir)1807 static mus_float_t convolve_next_sample(void *ptr, int dir)
1808 {
1809 return(read_sample(((snd_fd *)ptr)));
1810 }
1811
1812
1813
convolution_filter(chan_info * cp,int order,env * e,snd_fd * sf,mus_long_t beg,mus_long_t dur,const char * origin,mus_float_t * precalculated_coeffs)1814 static char *convolution_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_long_t beg, mus_long_t dur,
1815 const char *origin, mus_float_t *precalculated_coeffs)
1816 {
1817 snd_info *sp;
1818 file_info *hdr = NULL;
1819 int ofd = 0, datumb = 0;
1820 char *ofile = NULL;
1821 int fsize;
1822 mus_float_t *fltdat = NULL;
1823 io_error_t io_err = IO_NO_ERROR;
1824
1825 if (!(is_editable(cp))) return(NULL);
1826 sp = cp->sound;
1827
1828 dur += order;
1829 if (dur < TWO_30)
1830 fsize = snd_to_int_pow2(dur);
1831 else fsize = TWO_30;
1832
1833 ofile = snd_tempnam();
1834 hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, (char *)origin);
1835
1836 #if MUS_LITTLE_ENDIAN
1837 if (sizeof(mus_float_t) == 4)
1838 hdr->sample_type = MUS_LFLOAT;
1839 else hdr->sample_type = MUS_LDOUBLE;
1840 #else
1841 if (sizeof(mus_float_t) == 4)
1842 hdr->sample_type = MUS_BFLOAT;
1843 else hdr->sample_type = MUS_BDOUBLE;
1844 #endif
1845
1846 ofd = open_temp_file(ofile, 1, hdr, &io_err);
1847 if (ofd == -1)
1848 {
1849 return(mus_format("%s %s temp file %s: %s\n",
1850 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
1851 origin, ofile,
1852 snd_open_strerror()));
1853 }
1854
1855 if (fsize > MAX_SINGLE_FFT_SIZE)
1856 {
1857 /* set up convolution generator and run overlap-add in order-sized blocks */
1858 bool reporting;
1859 mus_any *gen;
1860 mus_float_t **data;
1861 mus_float_t *idata;
1862 mus_long_t alloc_len;
1863 int j;
1864
1865 reporting = ((sp) && (dur > REPORTING_SIZE) && (!(cp->squelch_update)));
1866 if (order == 0) order = 65536; /* presumably fsize is enormous here, so no MIN needed */
1867 if (!(is_power_of_2(order)))
1868 order = snd_to_int_pow2(order);
1869 fsize = 2 * order; /* need room for convolution */
1870 if (precalculated_coeffs)
1871 fltdat = precalculated_coeffs;
1872 else fltdat = get_filter_coeffs(order, e);
1873
1874 gen = mus_make_convolve(convolve_next_sample, fltdat, fsize, order, (void *)sf);
1875
1876 if (dur > MAX_BUFFER_SIZE)
1877 alloc_len = MAX_BUFFER_SIZE;
1878 else alloc_len = dur;
1879
1880 data = (mus_float_t **)malloc(sizeof(mus_float_t *));
1881 data[0] = (mus_float_t *)malloc(alloc_len * sizeof(mus_float_t));
1882 idata = data[0];
1883
1884 if (reporting) start_progress_report(cp);
1885 ss->stopped_explicitly = false;
1886
1887 if (alloc_len == dur)
1888 {
1889 for (j = 0; j < dur; j++)
1890 idata[j] = mus_convolve(gen, NULL);
1891 mus_file_write(ofd, 0, dur - 1, 1, data);
1892 }
1893 else
1894 {
1895 mus_long_t offk;
1896 for (offk = 0; offk < dur; offk += alloc_len)
1897 {
1898 mus_long_t kdur;
1899 kdur = dur - offk;
1900 if (kdur > alloc_len) kdur = alloc_len;
1901 for (j = 0; j < kdur; j++)
1902 idata[j] = mus_convolve(gen, NULL);
1903 mus_file_write(ofd, 0, kdur - 1, 1, data);
1904 if (reporting)
1905 {
1906 progress_report(cp, (mus_float_t)((double)offk / (double)dur));
1907 if (ss->stopped_explicitly) break;
1908 if (!(sp->active))
1909 {
1910 ss->stopped_explicitly = true;
1911 break;
1912 }
1913 }
1914 }
1915 }
1916 if (reporting) finish_progress_report(cp);
1917 close_temp_file(ofile, ofd, hdr->type, dur * datumb);
1918 if (!(ss->stopped_explicitly))
1919 file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, origin, sf->edit_ctr);
1920 else
1921 {
1922 set_status(sp, "filter interrupted", false);
1923 ss->stopped_explicitly = false;
1924 }
1925 mus_free(gen);
1926 free(data[0]);
1927 free(data);
1928 }
1929 else
1930 {
1931 /* we think there's enough memory to do the entire thing in one pass */
1932 if (precalculated_coeffs)
1933 fltdat = precalculated_coeffs;
1934 else fltdat = sample_linear_env(e, fsize);
1935 if (fltdat)
1936 {
1937 mus_float_t *sndrdat, *sndidat;
1938 mus_float_t scale;
1939 mus_long_t k;
1940 ssize_t bytes;
1941
1942 sndrdat = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
1943 sndidat = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
1944
1945 samples_to_vct_with_reader(dur, sndrdat, sf);
1946 mus_fft(sndrdat, sndidat, fsize, 1);
1947 scale = 1.0 / (mus_float_t)fsize;
1948 for (k = 0; k < fsize; k++)
1949 {
1950 double scl;
1951 scl = scale * fltdat[k];
1952 sndrdat[k] *= scl; /* fltdat is already reflected around midpoint */
1953 sndidat[k] *= scl;
1954 }
1955 mus_fft(sndrdat, sndidat, fsize, -1);
1956
1957 bytes = write(ofd, sndrdat, fsize * sizeof(mus_float_t));
1958 close_temp_file(ofile, ofd, hdr->type, fsize * sizeof(mus_float_t));
1959 if (bytes != 0)
1960 file_change_samples(beg, dur + order, ofile, cp, 0, DELETE_ME, origin, sf->edit_ctr);
1961 else set_status(sp, "can't write data?", false);
1962
1963 free(sndrdat);
1964 free(sndidat);
1965 }
1966 else
1967 {
1968 close_temp_file(ofile, ofd, hdr->type, 0);
1969 snd_remove(ofile, REMOVE_FROM_CACHE);
1970 }
1971 }
1972 if (ofile) {free(ofile); ofile = NULL;}
1973 free_file_info(hdr);
1974 if ((fltdat) && (!precalculated_coeffs)) free(fltdat);
1975 update_graph(cp);
1976 return(NULL);
1977 }
1978
1979 mus_float_t next_sample_value_unscaled(snd_fd *sf);
1980 mus_float_t next_sound(snd_fd *sf);
1981
direct_filter(chan_info * cp,int order,env * e,snd_fd * sf,mus_long_t beg,mus_long_t dur,const char * origin,bool truncate,bool over_selection,mus_any * gen,mus_float_t * precalculated_coeffs)1982 static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_long_t beg, mus_long_t dur,
1983 const char *origin, bool truncate,
1984 bool over_selection, mus_any *gen, mus_float_t *precalculated_coeffs)
1985 {
1986 mus_float_t *fcoeffs = NULL;
1987 snd_info *sp;
1988 bool reporting = false;
1989 mus_long_t offk;
1990 file_info *hdr = NULL;
1991 int j = 0, ofd = 0, datumb = 0, err = 0;
1992 bool temp_file;
1993 char *new_origin = NULL;
1994 mus_float_t **data;
1995 mus_float_t *idata;
1996 char *ofile = NULL;
1997 io_error_t io_err = IO_NO_ERROR;
1998 mus_any *g = NULL;
1999 mus_float_t (*runf)(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
2000 mus_float_t (*runf1)(mus_any *gen, mus_float_t arg);
2001
2002 if (!(is_editable(cp))) return(NULL);
2003 sp = cp->sound;
2004 if ((!over_selection) || (!truncate))
2005 dur += order;
2006 /* if over-selection this causes it to clobber samples beyond the selection end -- maybe mix? */
2007 reporting = ((sp) && (dur > REPORTING_SIZE) && (!(cp->squelch_update)));
2008 if (reporting) start_progress_report(cp);
2009
2010 if (!gen)
2011 {
2012 if (precalculated_coeffs)
2013 fcoeffs = precalculated_coeffs;
2014 else
2015 {
2016 if (order & 1) order++;
2017 fcoeffs = get_filter_coeffs(order, e);
2018 if (!fcoeffs) return(NULL);
2019 }
2020 }
2021
2022 if (dur > MAX_BUFFER_SIZE)
2023 {
2024 temp_file = true;
2025 ofile = snd_tempnam();
2026 hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, (char *)origin);
2027 ofd = open_temp_file(ofile, 1, hdr, &io_err);
2028 if (ofd == -1)
2029 {
2030 return(mus_format("%s %s temp file %s: %s\n",
2031 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
2032 origin, ofile,
2033 snd_open_strerror()));
2034 }
2035 datumb = mus_bytes_per_sample(hdr->sample_type);
2036 }
2037 else temp_file = false;
2038
2039 data = (mus_float_t **)malloc(sizeof(mus_float_t *));
2040 data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
2041 idata = data[0];
2042
2043 sampler_set_safe(sf, dur);
2044
2045 if (gen)
2046 {
2047 mus_reset(gen);
2048 g = gen;
2049 }
2050 else
2051 {
2052 g = mus_make_fir_filter(order, fcoeffs, NULL);
2053 if (over_selection)
2054 {
2055 int m;
2056 mus_long_t prebeg = 0;
2057 /* see if there's data to pre-load the filter */
2058 if (beg >= order)
2059 prebeg = order - 1;
2060 else prebeg = beg;
2061 if (prebeg > 0)
2062 for (m = (int)prebeg; m > 0; m--)
2063 mus_fir_filter(g, read_sample(sf));
2064 }
2065 }
2066 if ((over_selection) && (!truncate))
2067 dur -= order;
2068
2069 runf = mus_run_function(g);
2070 runf1 = mus_run1_function(g);
2071 if (!temp_file)
2072 {
2073 if (sf->runf == next_sample_value_unscaled)
2074 {
2075 if (runf1)
2076 {
2077 for (j = 0; j < dur; j++)
2078 idata[j] = runf1(g, (sf->loc > sf->last) ? next_sound(sf) : sf->data[sf->loc++]);
2079 }
2080 else
2081 {
2082 for (j = 0; j < dur; j++)
2083 idata[j] = runf(g, (sf->loc > sf->last) ? next_sound(sf) : sf->data[sf->loc++], 0.0);
2084 }
2085 }
2086 else
2087 {
2088 for (j = 0; j < dur; j++)
2089 idata[j] = runf(g, read_sample(sf), 0.0);
2090 }
2091 }
2092 else
2093 {
2094 for (offk = 0; offk < dur; offk += MAX_BUFFER_SIZE)
2095 {
2096 mus_long_t kdur;
2097 kdur = dur - offk;
2098 if (kdur > MAX_BUFFER_SIZE) kdur = MAX_BUFFER_SIZE;
2099
2100 if (sf->runf == next_sample_value_unscaled)
2101 {
2102 if (runf1)
2103 {
2104 for (j = 0; j < kdur; j++)
2105 idata[j] = runf1(g, (sf->loc > sf->last) ? next_sound(sf) : sf->data[sf->loc++]);
2106 }
2107 else
2108 {
2109 for (j = 0; j < kdur; j++)
2110 idata[j] = runf(g, (sf->loc > sf->last) ? next_sound(sf) : sf->data[sf->loc++], 0.0);
2111 }
2112 }
2113 else
2114 {
2115 for (j = 0; j < kdur; j++)
2116 idata[j] = runf(g, read_sample(sf), 0.0);
2117 }
2118
2119 err = mus_file_write(ofd, 0, j - 1, 1, data);
2120 if (err != MUS_NO_ERROR) break;
2121 if (reporting)
2122 {
2123 progress_report(cp, (mus_float_t)((double)offk / (double)dur));
2124 if (ss->stopped_explicitly) return(NULL);
2125 if (!(sp->active))
2126 {
2127 ss->stopped_explicitly = true;
2128 break;
2129 }
2130 }
2131 }
2132 }
2133
2134 if ((over_selection) && (!truncate))
2135 {
2136 snd_fd *sfold;
2137 sfold = init_sample_read_any(beg + dur, cp, READ_FORWARD, sf->edit_ctr);
2138 for (offk = 0; offk < order; offk++)
2139 {
2140 idata[j] = runf(g, read_sample(sf), 0.0) + read_sample(sfold);
2141 j++;
2142 if ((temp_file) && (j == MAX_BUFFER_SIZE))
2143 {
2144 err = mus_file_write(ofd, 0, j - 1, 1, data);
2145 j = 0;
2146 if (err != MUS_NO_ERROR) break;
2147 }
2148 }
2149 dur += order;
2150 free_snd_fd(sfold);
2151 }
2152
2153 if (reporting) finish_progress_report(cp);
2154 if ((origin) && (!mus_strcmp(origin, S_filter_channel)))
2155 new_origin = mus_strdup(origin);
2156 else
2157 {
2158 if (precalculated_coeffs)
2159 {
2160 vct *v;
2161 char *vstr;
2162
2163 v = mus_vct_wrap(order, precalculated_coeffs);
2164 vstr = mus_vct_to_readable_string(v);
2165
2166 #if HAVE_FORTH
2167 if (dur == (order + cp->edits[sf->edit_ctr]->samples))
2168 new_origin = mus_format("%s %d %" print_mus_long PROC_SEP PROC_FALSE " %s", vstr, order, beg, S_filter_channel);
2169 else new_origin = mus_format("%s %d %" print_mus_long PROC_SEP "%" print_mus_long " %s", vstr, order, beg, dur, S_filter_channel);
2170 #else
2171 if (dur == (order + cp->edits[sf->edit_ctr]->samples))
2172 new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE,
2173 to_proc_name(S_filter_channel), vstr, order, beg);
2174 else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long,
2175 to_proc_name(S_filter_channel), vstr, order, beg, dur);
2176 #endif
2177
2178 if (vstr) free(vstr);
2179 #if (!HAVE_SCHEME)
2180 mus_vct_free(v);
2181 #endif
2182 }
2183 else
2184 {
2185 /* new_origin = filter-channel + envelope */
2186 char *envstr;
2187 envstr = env_to_string(e);
2188
2189 #if HAVE_FORTH
2190 if (dur == (order + cp->edits[sf->edit_ctr]->samples))
2191 new_origin = mus_format("%s %d %" print_mus_long PROC_SEP PROC_FALSE " %s", envstr, order, beg, S_filter_channel);
2192 else new_origin = mus_format("%s %d %" print_mus_long PROC_SEP "%" print_mus_long " %s", envstr, order, beg, dur, S_filter_channel);
2193 #else
2194 if (dur == (order + cp->edits[sf->edit_ctr]->samples))
2195 new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE,
2196 to_proc_name(S_filter_channel), envstr, order, beg);
2197 else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long,
2198 to_proc_name(S_filter_channel), envstr, order, beg, dur);
2199 #endif
2200 if (envstr) free(envstr);
2201 }
2202 }
2203
2204 if (temp_file)
2205 {
2206 if (j > 0) mus_file_write(ofd, 0, j - 1, 1, data);
2207 close_temp_file(ofile, ofd, hdr->type, dur * datumb);
2208 free_file_info(hdr);
2209 file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, new_origin, sf->edit_ctr);
2210 if (ofile) {free(ofile); ofile = NULL;}
2211 }
2212 else change_samples(beg, dur, data[0], cp, new_origin, sf->edit_ctr, -1.0);
2213 if (new_origin) free(new_origin);
2214
2215 update_graph(cp);
2216
2217 free(data[0]);
2218 free(data);
2219 if (!gen) mus_free(g);
2220 if ((fcoeffs) && (!precalculated_coeffs)) free(fcoeffs);
2221 return(NULL);
2222 }
2223
2224
filter_channel(chan_info * cp,int order,env * e,mus_long_t beg,mus_long_t dur,int edpos,const char * origin,bool truncate,mus_float_t * coeffs)2225 static char *filter_channel(chan_info *cp, int order, env *e, mus_long_t beg, mus_long_t dur, int edpos, const char *origin, bool truncate, mus_float_t *coeffs)
2226 {
2227 bool over_selection;
2228 snd_fd *sf;
2229 char *errstr = NULL;
2230 if ((order == 1) && (coeffs) && (!e))
2231 {
2232 /* a silly optimization... */
2233 if ((coeffs[0] != 1.0) || (edpos != cp->edit_ctr))
2234 scale_channel(cp, coeffs[0], beg, dur, edpos, NOT_IN_AS_ONE_EDIT);
2235 return(NULL);
2236 }
2237 over_selection = ((beg != 0) || (dur < cp->edits[edpos]->samples));
2238 sf = init_sample_read_any(beg, cp, READ_FORWARD, edpos);
2239
2240 if ((!over_selection) &&
2241 ((order == 0) ||
2242 (order >= 128)))
2243 errstr = convolution_filter(cp, order, e, sf, beg, dur, origin, coeffs);
2244 else errstr = direct_filter(cp, order, e, sf, beg, dur, origin, truncate, over_selection, NULL, coeffs);
2245
2246 free_snd_fd(sf);
2247 return(errstr);
2248 }
2249
2250
apply_filter_or_error(chan_info * ncp,int order,env * e,const char * caller,const char * origin,bool over_selection,mus_float_t * ur_a,mus_any * gen,Xen edpos,int arg_pos,bool truncate,bool * clm_error)2251 static char *apply_filter_or_error(chan_info *ncp, int order, env *e,
2252 const char *caller, const char *origin, bool over_selection, mus_float_t *ur_a,
2253 mus_any *gen, Xen edpos, int arg_pos, bool truncate, bool *clm_error)
2254 {
2255 /* if string returned, needs to be freed */
2256 /* interpret e as frequency response and apply as filter to all sync'd chans */
2257 sync_state *sc;
2258 sync_info *si;
2259 snd_info *sp;
2260 int i, stop_point = 0;
2261 mus_long_t scdur, dur;
2262 snd_fd **sfs;
2263 chan_info *cp;
2264 char *errstr = NULL;
2265
2266 if ((!e) && (!ur_a) && (!gen))
2267 return(NULL);
2268
2269 if ((gen) && (!(mus_run_function(gen))))
2270 {
2271 (*clm_error) = true;
2272 return(mus_format("%s: can't handle %s generators",
2273 caller,
2274 mus_name(gen)));
2275 }
2276
2277 sp = ncp->sound;
2278 sc = get_sync_state_1(sp, ncp, 0, over_selection,
2279 READ_FORWARD, (over_selection) ? (order - 1) : 0,
2280 edpos,
2281 caller, arg_pos);
2282 if (!sc) return(NULL);
2283
2284 si = sc->si;
2285 sfs = sc->sfs;
2286 scdur = sc->dur;
2287 ss->stopped_explicitly = false;
2288
2289 if ((!ur_a) &&
2290 (!gen) &&
2291 (!over_selection) &&
2292 ((order == 0) || (order >= 128)))
2293 {
2294 /* use convolution if order is large and not over_selection */
2295 for (i = 0; i < si->chans; i++)
2296 {
2297 cp = si->cps[i];
2298 sp = cp->sound;
2299 if (!(sp->active)) continue;
2300 if (scdur == 0)
2301 dur = to_c_edit_samples(cp, edpos, caller, arg_pos);
2302 else dur = scdur;
2303 if (dur == 0)
2304 {
2305 sfs[i] = free_snd_fd(sfs[i]);
2306 continue;
2307 }
2308
2309 errstr = convolution_filter(cp, order, e, sfs[i], si->begs[i], dur, (origin) ? origin : caller, NULL);
2310
2311 sfs[i] = free_snd_fd(sfs[i]);
2312 check_for_event();
2313 if ((errstr) || (ss->stopped_explicitly))
2314 {
2315 stop_point = i;
2316 break;
2317 }
2318 }
2319 }
2320 else
2321 {
2322 /* use FIR filter */
2323 mus_float_t *a = NULL;
2324 if (order == 0) order = enved_filter_order(ss);
2325 if (!gen)
2326 {
2327 if (ur_a)
2328 a = ur_a;
2329 else
2330 {
2331 if (order & 1) order++;
2332 a = get_filter_coeffs(order, e);
2333 }
2334 if (!a) return(NULL);
2335 }
2336 /* now filter all currently sync'd chans (one by one) */
2337 /* for each decide whether a file or internal array is needed, scale, update edit tree */
2338 if (!(ss->stopped_explicitly))
2339 {
2340 for (i = 0; i < si->chans; i++)
2341 {
2342 /* done channel at a time here, rather than in parallel as in apply-env because */
2343 /* in this case, the various sync'd channels may be different lengths */
2344 cp = si->cps[i];
2345 if (scdur == 0)
2346 dur = to_c_edit_samples(cp, edpos, caller, arg_pos);
2347 else dur = scdur;
2348 if (dur == 0)
2349 {
2350 sfs[i] = free_snd_fd(sfs[i]);
2351 continue;
2352 }
2353
2354 errstr = direct_filter(cp, order, e, sfs[i], si->begs[i], dur,
2355 (origin) ? origin : caller, truncate, over_selection,
2356 gen, a);
2357
2358 sfs[i] = free_snd_fd(sfs[i]);
2359 if ((errstr) || (ss->stopped_explicitly))
2360 {
2361 stop_point = i;
2362 break;
2363 }
2364 }
2365 }
2366 if ((a) && (!ur_a)) free(a);
2367 }
2368
2369 if (ss->stopped_explicitly)
2370 {
2371 /* clean up and undo all edits up to stop_point */
2372 set_status(sp, "filter stopped", false);
2373 ss->stopped_explicitly = false;
2374 for (i = 0; i <= stop_point; i++)
2375 {
2376 cp = si->cps[i];
2377 undo_edit(cp, 1);
2378 }
2379 }
2380 free_sync_state(sc);
2381 return(errstr);
2382 }
2383
2384
apply_filter(chan_info * ncp,int order,env * e,const char * caller,const char * origin,bool over_selection,mus_float_t * ur_a,mus_any * gen,Xen edpos,int arg_pos,bool truncate)2385 void apply_filter(chan_info *ncp, int order, env *e,
2386 const char *caller, const char *origin, bool over_selection, mus_float_t *ur_a, mus_any *gen,
2387 Xen edpos, int arg_pos, bool truncate)
2388 {
2389 char *error;
2390 bool err_type; /* ignored in this context */
2391 error = apply_filter_or_error(ncp, order, e, caller, origin, over_selection, ur_a, gen, edpos, arg_pos, truncate, &err_type);
2392 if (error)
2393 {
2394 snd_error_without_format(error);
2395 free(error);
2396 }
2397 }
2398
edit_list_envelope(mus_any * egen,mus_long_t beg,mus_long_t env_dur,mus_long_t called_dur,mus_long_t chan_dur,mus_float_t base)2399 static char *edit_list_envelope(mus_any *egen, mus_long_t beg, mus_long_t env_dur, mus_long_t called_dur, mus_long_t chan_dur, mus_float_t base)
2400 {
2401 char *new_origin, *envstr;
2402 env *newe;
2403
2404 newe = make_envelope_with_offset_and_scaler(mus_data(egen), mus_env_breakpoints(egen) * 2, mus_offset(egen), mus_scaler(egen));
2405 /* mus_env_offset|scaler are the fixed up versions, the originals are mus_offset|scaler. mus_data is the original data */
2406
2407 envstr = env_to_string(newe);
2408 if (((env_dur == chan_dur) || (env_dur == (chan_dur - 1))) &&
2409 (called_dur == chan_dur))
2410 {
2411 #if HAVE_FORTH
2412 if (base == 1.0)
2413 new_origin = mus_format("%s %" print_mus_long PROC_SEP PROC_FALSE " %s", envstr, beg, S_env_channel);
2414 else new_origin = mus_format("%s %.4f %" print_mus_long PROC_SEP PROC_FALSE " %s",
2415 envstr, base, beg, S_env_channel_with_base);
2416 #else
2417 if (base == 1.0)
2418 new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE,
2419 to_proc_name(S_env_channel), envstr, beg);
2420 else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%.4f" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE,
2421 to_proc_name(S_env_channel_with_base), envstr, base, beg);
2422 #endif
2423 }
2424 else
2425 {
2426 /* env dur was apparently not chan dur, or called dur was not full sound? */
2427 #if HAVE_FORTH
2428 new_origin = mus_format("%s :base %.4f :end %" print_mus_long " %s %" print_mus_long PROC_SEP "%" print_mus_long " %s",
2429 envstr, base, env_dur, S_make_env, beg, called_dur, S_env_channel);
2430 #else
2431 new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%" print_mus_long ")" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long,
2432 to_proc_name(S_env_channel), to_proc_name(S_make_env), envstr, base, env_dur, beg, called_dur);
2433 #endif
2434 }
2435 if (envstr) free(envstr);
2436 free_env(newe);
2437 return(new_origin);
2438 }
2439
2440
apply_env(chan_info * cp,env * e,mus_long_t beg,mus_long_t dur,bool over_selection,const char * origin,mus_any * gen,Xen edpos,int arg_pos)2441 void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_selection,
2442 const char *origin, mus_any *gen, Xen edpos, int arg_pos)
2443 {
2444 /* basic cases: if env has 1 y value, use scale-channel,
2445 * if step env (base == 0.0), use sequence of scale-channels,
2446 * if not optimizable (via virtual edits), call mus_env on each sample
2447 * if optimizable, use sequence of (x)ramp-channels
2448 */
2449 /* e can be NULL => use gen */
2450 snd_info *sp;
2451 sync_info *si;
2452 sync_state *sc = NULL;
2453 int i, j, k, len;
2454 bool scalable = true, rampable = true, is_xramp = false;
2455 mus_float_t val[1];
2456 mus_any *egen;
2457 mus_long_t *passes;
2458 mus_float_t *rates;
2459 mus_float_t base;
2460 mus_float_t scaler, offset;
2461
2462 if ((!e) && (!gen)) return;
2463 if (over_selection) dur = selection_len();
2464 if (dur <= 0) return;
2465 if (e)
2466 {
2467 if (e->pts == 0) return;
2468 val[0] = e->data[1]; /* ok because no possibility of scaler/offset here */
2469 for (i = 1, j = 2; i < e->pts; i++, j += 2)
2470 if (e->data[j + 1] != val[0])
2471 {
2472 scalable = false;
2473 break;
2474 }
2475 if ((scalable) &&
2476 (beg == 0))
2477 {
2478 int pos;
2479 pos = to_c_edit_position(cp, edpos, origin, arg_pos);
2480 if ((cp->edit_ctr == pos) &&
2481 (dur >= cp->edits[pos]->samples))
2482 {
2483 scale_by(cp, val, 1, over_selection);
2484 return;
2485 }
2486 }
2487 }
2488 else scalable = false;
2489
2490 si = NULL;
2491 sp = cp->sound;
2492 if (scalable) /* only true if e (not gen) and all vals are equal and not full chan (latter case handled above) */
2493 {
2494 /* ---------------- use scale-channel ---------------- */
2495 sc = get_sync_state_without_snd_fds(sp, cp, beg, over_selection);
2496 if (!sc) return;
2497 si = sc->si;
2498 for (i = 0; i < si->chans; i++)
2499 {
2500 if (over_selection)
2501 scale_channel(si->cps[i],
2502 val[0],
2503 si->begs[i],
2504 selection_end(si->cps[i]) - si->begs[i] + 1,
2505 to_c_edit_position(si->cps[i], edpos, origin, arg_pos),
2506 NOT_IN_AS_ONE_EDIT);
2507 else scale_channel(si->cps[i], val[0], si->begs[i], dur,
2508 to_c_edit_position(si->cps[i], edpos, origin, arg_pos),
2509 NOT_IN_AS_ONE_EDIT);
2510 }
2511 free_sync_state(sc);
2512 return;
2513 }
2514
2515 if (e)
2516 egen = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, dur - 1, NULL);
2517 else egen = gen;
2518 len = mus_env_breakpoints(egen);
2519 passes = mus_env_passes(egen);
2520 rates = mus_env_rates(egen);
2521 scaler = mus_env_scaler(egen); /* fixed-up versions if base != 1.0 */
2522 offset = mus_env_offset(egen);
2523 base = mus_increment(egen);
2524
2525 if (base == 0.0)
2526 {
2527 /* ---------------- step env -- handled as sequence of scalings ---------------- */
2528 int local_edpos, pos;
2529 mus_long_t segbeg, segnum, segend;
2530 /* base == 0 originally, so it's a step env */
2531 sc = get_sync_state_without_snd_fds(sp, cp, beg, over_selection);
2532 if (!sc)
2533 {
2534 if (e) mus_free(egen);
2535 return;
2536 }
2537 si = sc->si;
2538 for (i = 0; i < si->chans; i++)
2539 {
2540 bool edited = false;
2541 if (!(is_editable(si->cps[i]))) continue;
2542 segbeg = si->begs[i];
2543 segend = si->begs[i] + dur;
2544 segnum = passes[0] + 1;
2545 local_edpos = si->cps[i]->edit_ctr; /* for as_one_edit backup */
2546 pos = to_c_edit_position(si->cps[i], edpos, origin, arg_pos);
2547 for (k = 0; k < len; k++)
2548 {
2549 if ((segbeg + segnum) > segend)
2550 segnum = segend - segbeg;
2551 else
2552 if ((k == (len - 1)) &&
2553 ((segbeg + segnum) < segend))
2554 segnum = segend - segbeg; /* last value is sticky in envs */
2555 if (segnum > 0)
2556 {
2557 if (scale_channel(si->cps[i], (mus_float_t)(offset + scaler * rates[k]), segbeg, segnum, pos, IN_AS_ONE_EDIT))
2558 edited = true;
2559 pos = si->cps[i]->edit_ctr;
2560 }
2561 segbeg += segnum;
2562 if (segbeg >= segend) break;
2563 segnum = passes[k + 1] - passes[k];
2564 }
2565 if (edited)
2566 {
2567 as_one_edit(si->cps[i], local_edpos + 1);
2568 if (cp->edits[cp->edit_ctr]->origin) free(cp->edits[cp->edit_ctr]->origin);
2569 cp->edits[cp->edit_ctr]->origin = edit_list_envelope(egen, si->begs[i], (len > 1) ? (passes[len - 2]) : dur, dur, current_samples(si->cps[i]), base);
2570 after_edit(cp);
2571 update_graph(si->cps[i]);
2572 reflect_edit_history_change(si->cps[i]);
2573 }
2574 }
2575 free_sync_state(sc);
2576 if (e) mus_free(egen);
2577 return;
2578 }
2579
2580 /* step env, special env, and degenerate cases are out of the way */
2581 /* need to use the same sync/selection choice as will be used below! */
2582 sc = get_sync_state_without_snd_fds(sp, cp, beg, over_selection);
2583 si = sc->si;
2584 if (base != 1.0) is_xramp = true;
2585 for (i = 0; i < si->chans; i++)
2586 if (unrampable(si->cps[i], si->begs[i], dur, to_c_edit_position(si->cps[i], edpos, origin, arg_pos), is_xramp))
2587 {
2588 rampable = false;
2589 break;
2590 }
2591 free_sync_state(sc);
2592
2593 if (!rampable)
2594 {
2595 /* ---------------- not optimizable, so call mus_env on each sample ---------------- */
2596 mus_long_t ioff, alloc_len;
2597 mus_float_t **data;
2598 bool reporting = false, temp_file = false;
2599 int ofd = 0, datumb = 0;
2600 file_info *hdr = NULL;
2601 char *ofile = NULL;
2602 snd_fd **sfs;
2603
2604 /* run env over samples */
2605 sc = get_sync_state(sp, cp, beg, over_selection, READ_FORWARD, edpos, origin, arg_pos);
2606 if (!sc)
2607 {
2608 if (e) mus_free(egen);
2609 return;
2610 }
2611 si = sc->si;
2612 sfs = sc->sfs;
2613 if (dur > MAX_BUFFER_SIZE)
2614 {
2615 io_error_t io_err = IO_NO_ERROR;
2616
2617 alloc_len = MAX_BUFFER_SIZE;
2618 temp_file = true;
2619 ofile = snd_tempnam();
2620 hdr = make_temp_header(ofile, snd_srate(sp), si->chans, dur, (char *)origin);
2621 ofd = open_temp_file(ofile, si->chans, hdr, &io_err);
2622 if (ofd == -1)
2623 {
2624 if (e) mus_free(egen);
2625 for (i = 0; i < si->chans; i++)
2626 sfs[i] = free_snd_fd(sfs[i]);
2627 free_sync_state(sc);
2628 if (e) mus_free(egen);
2629 snd_error("%s %s temp file %s: %s\n",
2630 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
2631 origin, ofile,
2632 snd_open_strerror());
2633 free(ofile);
2634 return;
2635 }
2636 datumb = mus_bytes_per_sample(hdr->sample_type);
2637 }
2638 else
2639 {
2640 temp_file = false;
2641 alloc_len = dur;
2642 }
2643
2644 data = (mus_float_t **)malloc(si->chans * sizeof(mus_float_t *));
2645 for (i = 0; i < si->chans; i++)
2646 data[i] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
2647
2648 j = 0;
2649 reporting = ((dur > REPORTING_SIZE) && (!(cp->squelch_update)));
2650 if (reporting) start_progress_report(cp);
2651 if (si->chans > 1)
2652 {
2653 ss->stopped_explicitly = false;
2654 if (temp_file)
2655 {
2656 for (ioff = 0; ioff < dur; ioff++)
2657 {
2658 mus_float_t egen_val;
2659 egen_val = mus_env(egen);
2660 for (k = 0; k < si->chans; k++)
2661 data[k][j] = (read_sample(sfs[k]) * egen_val);
2662 j++;
2663 if (j == alloc_len)
2664 {
2665 int err;
2666 if (reporting)
2667 {
2668 progress_report(cp, (mus_float_t)((double)ioff / ((double)dur)));
2669 if (ss->stopped_explicitly) break;
2670 if (!(sp->active))
2671 {
2672 ss->stopped_explicitly = true;
2673 break;
2674 }
2675 }
2676 err = mus_file_write(ofd, 0, j - 1, si->chans, data);
2677 j = 0;
2678 if (err != MUS_NO_ERROR) break;
2679 }
2680 }
2681 }
2682 else
2683 {
2684 for (k = 0; k < si->chans; k++)
2685 samples_to_vct_with_reader(dur, data[k], sfs[k]);
2686 for (j = 0; j < dur; j++)
2687 {
2688 mus_float_t egen_val;
2689 egen_val = mus_env(egen);
2690 for (k = 0; k < si->chans; k++)
2691 data[k][j] *= egen_val;
2692 }
2693 }
2694 }
2695 else
2696 {
2697 mus_float_t *idata;
2698 snd_fd *sf;
2699 sf = sfs[0];
2700 idata = data[0];
2701 if (temp_file)
2702 {
2703 ss->stopped_explicitly = false;
2704 for (ioff = 0; ioff < dur; ioff++)
2705 {
2706 idata[j] = (read_sample(sf) * mus_env(egen));
2707 j++;
2708 if (j == alloc_len)
2709 {
2710 int err;
2711 if (reporting)
2712 {
2713 progress_report(cp, (mus_float_t)((double)ioff / ((double)dur)));
2714 if (ss->stopped_explicitly) break;
2715 if (!(sp->active))
2716 {
2717 ss->stopped_explicitly = true;
2718 break;
2719 }
2720 }
2721 err = mus_file_write(ofd, 0, j - 1, 1, data);
2722 j = 0;
2723 if (err != MUS_NO_ERROR) break;
2724 }
2725 }
2726 }
2727 else
2728 {
2729 samples_to_vct_with_reader(dur, idata, sf);
2730 for (j = 0; j < dur; j++)
2731 idata[j] *= mus_env(egen);
2732 }
2733 }
2734
2735 if (temp_file)
2736 {
2737 if (j > 0) mus_file_write(ofd, 0, j - 1, si->chans, data);
2738 close_temp_file(ofile, ofd, hdr->type, dur * si->chans * datumb);
2739 free_file_info(hdr);
2740 }
2741
2742 if (reporting) finish_progress_report(cp);
2743 if (ss->stopped_explicitly)
2744 {
2745 ss->stopped_explicitly = false;
2746 if (temp_file)
2747 snd_remove(ofile, REMOVE_FROM_CACHE);
2748 }
2749 else
2750 {
2751 if ((temp_file) &&
2752 (si->chans > 1))
2753 remember_temp(ofile, si->chans);
2754 for (i = 0; i < si->chans; i++)
2755 {
2756 char *new_origin;
2757 int pos;
2758 pos = to_c_edit_position(si->cps[i], edpos, origin, arg_pos);
2759 new_origin = edit_list_envelope(egen, si->begs[i], (len > 1) ? (passes[len - 2]) : dur, dur, current_samples(si->cps[i]), base);
2760 if (temp_file)
2761 {
2762 file_change_samples(si->begs[i], dur, ofile, si->cps[i], i,
2763 (si->chans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
2764 new_origin, pos);
2765 if ((si->begs[i] == 0) && (dur == si->cps[i]->edits[pos]->samples))
2766 amp_env_env(si->cps[i], mus_data(egen), len, pos, base, scaler, offset);
2767 else
2768 {
2769 if ((len < 2) || (snd_abs_mus_long_t(dur - passes[len - 2]) < 2))
2770 amp_env_env_selection_by(si->cps[i], egen, si->begs[i], dur, pos);
2771 }
2772
2773 }
2774 else change_samples(si->begs[i], dur, data[i], si->cps[i], new_origin, pos, -1.0);
2775 free(new_origin);
2776 update_graph(si->cps[i]);
2777 }
2778 }
2779 for (i = 0; i < si->chans; i++)
2780 {
2781 sfs[i] = free_snd_fd(sfs[i]);
2782 free(data[i]);
2783 }
2784 if ((temp_file) && (ofile)) {free(ofile); ofile = NULL;}
2785 if (data) free(data);
2786 }
2787 else
2788 {
2789 /* ---------------- optimizable -- treat env as a sequence of virtual (x)ramps and scalings (if slope=0) ---------------- */
2790 int local_edpos, m, pos, env_pos;
2791 bool need_xramp = false;
2792 mus_long_t segbeg, segnum, segend;
2793 double power = 0.0;
2794 mus_float_t *data;
2795
2796 data = mus_data(egen);
2797 if (base != 1.0) need_xramp = true;
2798 sc = get_sync_state_without_snd_fds(sp, cp, beg, over_selection);
2799 if (!sc)
2800 {
2801 if (e) mus_free(egen);
2802 return;
2803 }
2804 si = sc->si;
2805 /* in snd-test.scm, one sync_state pointer is lost here because env-channel requests edpos 2 (or is it 123?), but only 1 exists */
2806
2807 for (i = 0; i < si->chans; i++)
2808 {
2809 bool edited = false;
2810 if (!(is_editable(si->cps[i]))) continue;
2811 segbeg = si->begs[i];
2812 segend = si->begs[i] + dur;
2813 segnum = passes[0];
2814 local_edpos = si->cps[i]->edit_ctr; /* for as_one_edit backup */
2815 pos = to_c_edit_position(si->cps[i], edpos, origin, arg_pos);
2816 env_pos = pos;
2817 for (k = 0, m = 1; k < len; k++, m += 2)
2818 {
2819 bool applied_ramp = false;
2820
2821 if ((segbeg + segnum) > segend)
2822 segnum = segend - segbeg;
2823 else
2824 if ((k >= (len - 2)) &&
2825 ((segbeg + segnum) < segend))
2826 segnum = segend - segbeg; /* last value is sticky in envs */
2827
2828 if (segnum > 0)
2829 {
2830 if (k == 0)
2831 {
2832 if (need_xramp)
2833 {
2834 power = mus_env_initial_power(egen);
2835 applied_ramp = xramp_channel(si->cps[i],
2836 power,
2837 rates[0],
2838 scaler, offset, segbeg, segnum, pos, IN_AS_ONE_EDIT, egen, 0);
2839 power *= exp(log(rates[0]) * segnum);
2840 }
2841 else applied_ramp = ramp_channel(si->cps[i],
2842 offset + scaler * data[m],
2843 rates[0],
2844 segbeg, segnum, pos, IN_AS_ONE_EDIT);
2845 }
2846 else
2847 {
2848 if (need_xramp)
2849 /* divide by segnum since we end at the break point and don't want to repeat it, so go to next position in env */
2850 {
2851 applied_ramp = xramp_channel(si->cps[i],
2852 power,
2853 rates[k],
2854 scaler, offset, segbeg, segnum, pos, IN_AS_ONE_EDIT, egen, k);
2855 power *= exp(log(rates[k]) * segnum);
2856 }
2857 else
2858 {
2859 if (k == (len - 1)) /* oops -- must have sticky end in play here? this doesn't work if a clm env passed */
2860 applied_ramp = scale_channel(si->cps[i],
2861 (mus_float_t)(offset + scaler * data[m]),
2862 segbeg, segnum, pos, IN_AS_ONE_EDIT);
2863 else applied_ramp = ramp_channel(si->cps[i],
2864 offset + scaler * data[m],
2865 rates[k],
2866 segbeg, segnum, pos, IN_AS_ONE_EDIT);
2867 }
2868 }
2869 pos = si->cps[i]->edit_ctr;
2870 }
2871
2872 if (!edited) edited = applied_ramp;
2873
2874 segbeg += segnum;
2875 if (segbeg >= segend) break;
2876 segnum = passes[k + 1] - passes[k];
2877 }
2878
2879 if (edited)
2880 {
2881 if ((si->begs[i] == 0) && (dur == si->cps[i]->edits[env_pos]->samples))
2882 amp_env_env(si->cps[i], mus_data(egen), len, env_pos, base, scaler, offset);
2883 else
2884 {
2885 if ((len < 2) || (snd_abs_mus_long_t(dur - passes[len - 2]) < 2))
2886 amp_env_env_selection_by(si->cps[i], egen, si->begs[i], dur, env_pos);
2887 }
2888
2889 as_one_edit(si->cps[i], local_edpos + 1);
2890 if (si->cps[i]->edits[si->cps[i]->edit_ctr]->origin)
2891 free(si->cps[i]->edits[si->cps[i]->edit_ctr]->origin);
2892 si->cps[i]->edits[si->cps[i]->edit_ctr]->origin = edit_list_envelope(egen,
2893 si->begs[i], (len > 1) ? (passes[len - 2]) : dur,
2894 dur,
2895 current_samples(si->cps[i]),
2896 base);
2897 after_edit(cp);
2898 update_graph(si->cps[i]);
2899 reflect_edit_history_change(si->cps[i]);
2900 }
2901 }
2902 }
2903 if (e) mus_free(egen);
2904 free_sync_state(sc);
2905 }
2906
2907
cursor_delete(chan_info * cp,mus_long_t count)2908 void cursor_delete(chan_info *cp, mus_long_t count)
2909 {
2910 mus_long_t beg;
2911 snd_info *sp;
2912 if (count == 0) return;
2913 if (count > 0)
2914 beg = cursor_sample(cp);
2915 else
2916 {
2917 count = -count;
2918 beg = cursor_sample(cp) - count;
2919 if (beg < 0)
2920 {
2921 count += beg;
2922 beg = 0;
2923 if (count <= 0) return;
2924 }
2925 }
2926 sp = cp->sound;
2927 if (sp->sync != 0)
2928 {
2929 int i;
2930 sync_info *si;
2931 chan_info **cps;
2932 si = snd_sync(sp->sync);
2933 cps = si->cps;
2934 for (i = 0; i < si->chans; i++)
2935 {
2936 if (delete_samples(beg, count, cps[i], cps[i]->edit_ctr))
2937 {
2938 cursor_sample(cps[i]) = beg;
2939 update_graph(si->cps[i]);
2940 }
2941 }
2942 free_sync_info(si);
2943 }
2944 else
2945 {
2946 if (delete_samples(beg, count, cp, cp->edit_ctr))
2947 {
2948 cursor_sample(cp) = beg;
2949 update_graph(cp);
2950 }
2951 }
2952 }
2953
2954
cursor_insert(chan_info * cp,mus_long_t beg,mus_long_t count)2955 void cursor_insert(chan_info *cp, mus_long_t beg, mus_long_t count)
2956 {
2957 snd_info *sp;
2958 sp = cp->sound;
2959 if (count < 0)
2960 {
2961 count = -count;
2962 if (count > beg) count = beg;
2963 beg -= count;
2964 }
2965 if (sp->sync != 0)
2966 {
2967 int i;
2968 sync_info *si;
2969 chan_info **cps;
2970 si = snd_sync(sp->sync);
2971 cps = si->cps;
2972 for (i = 0; i < si->chans; i++)
2973 {
2974 if ((count > 0) &&
2975 (extend_with_zeros(cps[i],
2976 mus_oclamp(0, beg, current_samples(si->cps[i])),
2977 count,
2978 cps[i]->edit_ctr,
2979 "cursor insert")))
2980 update_graph(cps[i]);
2981 }
2982 free_sync_info(si);
2983 }
2984 else
2985 {
2986 if ((count > 0) &&
2987 (extend_with_zeros(cp,
2988 mus_oclamp(0, beg, current_samples(cp)),
2989 count,
2990 cp->edit_ctr,
2991 "cursor insert")))
2992 update_graph(cp);
2993 }
2994 }
2995
2996
cursor_zeros(chan_info * cp,mus_long_t count,bool over_selection)2997 void cursor_zeros(chan_info *cp, mus_long_t count, bool over_selection)
2998 {
2999 int i;
3000 mus_long_t beg, num;
3001 snd_info *sp;
3002 sync_info *si = NULL;
3003 chan_info *ncp;
3004
3005 if (count == 0) return;
3006 if (count < 0) num = -count; else num = count;
3007 sp = cp->sound;
3008
3009 if ((sp->sync != 0) && (!over_selection))
3010 {
3011 si = snd_sync(sp->sync);
3012 for (i = 0; i < si->chans; i++)
3013 si->begs[i] = cursor_sample(cp);
3014 }
3015 else
3016 {
3017 if ((over_selection) && (selection_is_active()))
3018 {
3019 si = selection_sync();
3020 num = selection_len();
3021 }
3022 }
3023
3024 if (!si) si = make_simple_sync(cp, cursor_sample(cp));
3025
3026 for (i = 0; i < si->chans; i++)
3027 {
3028 /* if zeroing entire sound, set scalers and remake peak_env */
3029 ncp = si->cps[i];
3030 if ((si->begs[i] == 0) &&
3031 (num >= current_samples(ncp)))
3032 {
3033 mus_float_t scaler[1];
3034 snd_info *nsp;
3035 int old_sync;
3036 nsp = ncp->sound;
3037 old_sync = nsp->sync;
3038 nsp->sync = 0;
3039 scaler[0] = 0.0;
3040 scale_by(ncp, scaler, 1, OVER_SOUND);
3041 nsp->sync = old_sync;
3042 }
3043 else
3044 {
3045 if (count > 0)
3046 beg = si->begs[i];
3047 else beg = si->begs[i] + count;
3048 /* special case 1 sample -- if already 0, treat as no-op */
3049
3050 if ((count != 1) ||
3051 (beg >= current_samples(ncp)) ||
3052 (chn_sample(beg, ncp, ncp->edit_ctr) != 0.0))
3053 scale_channel(ncp, 0.0, beg, num, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT);
3054 }
3055 }
3056 free_sync_info(si);
3057 }
3058
3059
3060 /* smooth-channel could be a built-in virtual op, but the smoothed section is never long, so it doesn't save anything */
3061
smooth_channel(chan_info * cp,mus_long_t beg,mus_long_t dur,int edpos)3062 static void smooth_channel(chan_info *cp, mus_long_t beg, mus_long_t dur, int edpos)
3063 {
3064 mus_float_t *data = NULL;
3065 mus_long_t k;
3066 char *origin = NULL;
3067 mus_float_t y0, y1;
3068
3069 if ((beg < 0) || (dur <= 0)) return;
3070 if (!(is_editable(cp))) return;
3071 if ((beg + dur) > cp->edits[edpos]->samples)
3072 {
3073 dur = cp->edits[edpos]->samples - beg;
3074 if (dur <= 0) return;
3075 }
3076 y0 = chn_sample(beg, cp, edpos);
3077 y1 = chn_sample(beg + dur, cp, edpos); /* one past end -- this is a debatable choice */
3078
3079 #if HAVE_FORTH
3080 origin = mus_format("%" print_mus_long PROC_SEP "%" print_mus_long " %s", beg, dur, S_smooth_channel);
3081 #else
3082 origin = mus_format("%s" PROC_OPEN "%" print_mus_long PROC_SEP "%" print_mus_long, to_proc_name(S_smooth_channel), beg, dur);
3083 #endif
3084
3085 data = (mus_float_t *)malloc(dur * sizeof(mus_float_t));
3086 if (y0 == y1)
3087 {
3088 for (k = 0; k < dur; k++)
3089 data[k] = y0;
3090 change_samples(beg, dur, data, cp, origin, edpos, fabs(y0));
3091 }
3092 else
3093 {
3094 mus_float_t angle, incr, off, scale;
3095 if (y1 > y0) angle = M_PI; else angle = 0.0;
3096 incr = M_PI / (double)dur;
3097 off = 0.5 * (y1 + y0);
3098 scale = 0.5 * fabs(y0 - y1);
3099 /* if scale is very small, it might work here to just use linear interpolation, but that case appears to be very uncommon.
3100 */
3101 for (k = 0; k < dur; k++, angle += incr)
3102 data[k] = (off + scale * cos(angle));
3103 change_samples(beg, dur, data, cp, origin, edpos, ((y0 > y1) && (y1 >= 0.0)) ? y0 : -1.0);
3104 }
3105 if (origin) free(origin);
3106 update_graph(cp);
3107 free(data);
3108 }
3109
3110
cos_smooth(chan_info * cp,mus_long_t beg,mus_long_t num,bool over_selection)3111 void cos_smooth(chan_info *cp, mus_long_t beg, mus_long_t num, bool over_selection)
3112 {
3113 /* verbatim, so to speak from Dpysnd */
3114 /* start at beg, apply a cosine for num samples, matching endpoints */
3115 sync_state *sc;
3116 int i;
3117 snd_info *sp;
3118 sync_info *si;
3119
3120 sp = cp->sound;
3121 sc = get_sync_state_without_snd_fds(sp, cp, beg, over_selection);
3122 if (!sc) return;
3123 si = sc->si;
3124 if (over_selection) num = sc->dur;
3125
3126 for (i = 0; i < si->chans; i++)
3127 smooth_channel(si->cps[i], si->begs[i], num, si->cps[i]->edit_ctr);
3128
3129 free_sync_state(sc);
3130 }
3131
3132
3133 #if USE_MOTIF
3134 /* this is used by the view-files dialog */
3135
3136 typedef struct {
3137 snd_fd **fds;
3138 int len;
3139 } scale_and_src_data;
3140
3141
scale_and_src_input(void * data,int direction)3142 static mus_float_t scale_and_src_input(void *data, int direction)
3143 {
3144 scale_and_src_data *sd = (scale_and_src_data *)data;
3145 int i;
3146 mus_float_t sum;
3147 sum = 0.0;
3148 for (i = 0; i < sd->len; i++)
3149 if (sd->fds[i])
3150 sum += read_sample(sd->fds[i]);
3151 return(sum);
3152 }
3153
3154
scale_and_src(char ** files,int len,int max_chans,mus_float_t amp,mus_float_t speed,env * amp_env,bool * temp_file_err)3155 char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_float_t speed, env *amp_env, bool *temp_file_err)
3156 {
3157 /* view files mix and insert possible src change */
3158 char *tempfile;
3159 snd_fd ***fds = NULL;
3160 snd_info **sps = NULL;
3161 int i, chan, chans = 0;
3162 mus_long_t k, new_dur = 0, dur = 0;
3163 mus_float_t **data;
3164 file_info *hdr = NULL;
3165 int j, ofd = 0, datumb = 0, err = 0, srate = 0, olen;
3166 io_error_t io_err = IO_NO_ERROR;
3167 mus_float_t sum;
3168 mus_any *e = NULL;
3169 mus_any **sgens = NULL;
3170 scale_and_src_data **sdata = NULL;
3171
3172 (*temp_file_err) = false;
3173 tempfile = snd_tempnam();
3174
3175 for (i = 0; i < len; i++)
3176 {
3177 int fchans, fsrate;
3178 mus_long_t flen;
3179 fchans = mus_sound_chans(files[i]);
3180 flen = mus_sound_framples(files[i]);
3181 fsrate = mus_sound_srate(files[i]);
3182 if (chans < fchans) chans = fchans;
3183 if (srate < fsrate) srate = fsrate;
3184 if (dur < flen) dur = flen;
3185 }
3186
3187 /* open output sound file */
3188 hdr = make_temp_header(tempfile, srate, chans, dur, "scale-and-src temp");
3189 ofd = open_temp_file(tempfile, chans, hdr, &io_err);
3190 if (ofd == -1)
3191 {
3192 (*temp_file_err) = true;
3193 free_file_info(hdr);
3194 free(tempfile);
3195 return(mus_format("%s temp file %s: %s\n",
3196 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
3197 tempfile,
3198 snd_open_strerror()));
3199 }
3200
3201 olen = len * sizeof(snd_fd **); /* try to turn off gcc's alloc-size-larger-than error message */
3202 fds = (snd_fd ***)calloc(olen, 1);
3203 sps = (snd_info **)calloc(olen, 1);
3204 for (i = 0; i < len; i++)
3205 {
3206 fds[i] = (snd_fd **)calloc(max_chans, sizeof(snd_fd *));
3207 sps[i] = make_sound_readable(files[i], false);
3208 sps[i]->short_filename = filename_without_directory(files[i]);
3209 sps[i]->filename = NULL; /* why? squelch graphics perhaps? */
3210 for (chan = 0; chan < (int)sps[i]->nchans; chan++)
3211 fds[i][chan] = init_sample_read(0, sps[i]->chans[chan], READ_FORWARD);
3212 }
3213
3214 /* now we have readers set up for all chans of all sounds about to be mixed/scaled/enveloped/resampled... */
3215
3216 datumb = mus_bytes_per_sample(hdr->sample_type);
3217 data = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
3218 for (i = 0; i < chans; i++)
3219 data[i] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
3220
3221 if (!(snd_feq(speed, 1.0)))
3222 {
3223 new_dur = (mus_long_t)((double)dur / (double)speed);
3224 sgens = (mus_any **)calloc(chans, sizeof(mus_any *));
3225 sdata = (scale_and_src_data **)calloc(chans, sizeof(scale_and_src_data *));
3226 for (chan = 0; chan < chans; chan++)
3227 {
3228 int m;
3229 sdata[chan] = (scale_and_src_data *)calloc(1, sizeof(scale_and_src_data));
3230 sdata[chan]->len = len;
3231 sdata[chan]->fds = (snd_fd **)calloc(len, sizeof(snd_fd *));
3232 for (m = 0; m < len; m++)
3233 sdata[chan]->fds[m] = fds[m][chan];
3234
3235 sgens[chan] = mus_make_src(scale_and_src_input, speed, 0, (void *)(sdata[chan])); /* width=0 -> use current default */
3236 }
3237 }
3238 else new_dur = dur;
3239
3240 if (!(is_default_env(amp_env)))
3241 e = mus_make_env(amp_env->data, amp_env->pts, amp, 0.0, 1.0, 0.0, new_dur - 1, NULL);
3242
3243 j = 0;
3244 if (!sgens)
3245 {
3246 for (k = 0; k < dur; k++)
3247 {
3248 if (e) amp = mus_env(e);
3249 for (chan = 0; chan < chans; chan++)
3250 {
3251 sum = 0.0;
3252 for (i = 0; i < len; i++)
3253 if (fds[i][chan])
3254 sum += read_sample(fds[i][chan]);
3255 sum *= amp;
3256 data[chan][j] = (sum);
3257 }
3258 j++;
3259 if (j == MAX_BUFFER_SIZE)
3260 {
3261 err = mus_file_write(ofd, 0, j - 1, chans, data);
3262 j = 0;
3263 if (err != MUS_NO_ERROR) break;
3264 }
3265 }
3266 }
3267 else
3268 {
3269 for (k = 0; k < new_dur; k++)
3270 {
3271 if (e) amp = mus_env(e);
3272 for (chan = 0; chan < chans; chan++)
3273 data[chan][j] = (amp * mus_src(sgens[chan], 0.0, &scale_and_src_input));
3274 j++;
3275 if (j == MAX_BUFFER_SIZE)
3276 {
3277 err = mus_file_write(ofd, 0, j - 1, chans, data);
3278 j = 0;
3279 if (err != MUS_NO_ERROR) break;
3280 }
3281 }
3282 }
3283
3284 if (j > 0)
3285 mus_file_write(ofd, 0, j - 1, chans, data);
3286
3287 /* close and free everything */
3288 close_temp_file(tempfile, ofd, hdr->type, new_dur * datumb);
3289 hdr = free_file_info(hdr);
3290 if (e) mus_free(e);
3291
3292 for (i = 0; i < len; i++)
3293 {
3294 for (chan = 0; chan < (int)sps[i]->nchans; chan++)
3295 free_snd_fd(fds[i][chan]);
3296 free(fds[i]);
3297 sps[i] = completely_free_snd_info(sps[i]);
3298 }
3299 free(fds);
3300 free(sps);
3301
3302 for (i = 0; i < chans; i++)
3303 free(data[i]);
3304 free(data);
3305
3306 if (sgens)
3307 {
3308 for (chan = 0; chan < chans; chan++)
3309 {
3310 free(sdata[chan]->fds);
3311 free(sdata[chan]);
3312 mus_free(sgens[chan]);
3313 }
3314 free(sdata);
3315 free(sgens);
3316 }
3317
3318 return(tempfile);
3319 }
3320 #endif
3321
3322
map_channel_to_temp_file(chan_info * cp,snd_fd * sf,Xen proc,mus_long_t beg,mus_long_t num,int pos,const char * caller)3323 static Xen map_channel_to_temp_file(chan_info *cp, snd_fd *sf, Xen proc, mus_long_t beg, mus_long_t num, int pos, const char *caller)
3324 {
3325 snd_info *sp;
3326 int rpt4, ofd, datumb;
3327 char *filename;
3328 file_info *hdr;
3329 bool reporting;
3330 io_error_t io_err = IO_NO_ERROR;
3331 Xen res = Xen_false;
3332
3333 sampler_set_safe(sf, num);
3334 sp = cp->sound;
3335 reporting = ((num > REPORTING_SIZE) && (!(cp->squelch_update)));
3336 if (reporting) start_progress_report(cp);
3337 rpt4 = MAX_BUFFER_SIZE / 4;
3338
3339 filename = snd_tempnam();
3340 hdr = make_temp_header(filename, snd_srate(cp->sound), 1, 0, S_map_channel);
3341 datumb = mus_bytes_per_sample(hdr->sample_type);
3342
3343 ofd = open_temp_file(filename, 1, hdr, &io_err);
3344 if (ofd == -1)
3345 snd_error("%s: %s (temp file) %s: %s",
3346 S_map_channel,
3347 (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
3348 filename,
3349 snd_open_strerror());
3350 else
3351 {
3352 int err = MUS_NO_ERROR, i, j = 0, rpt = 0;
3353 mus_float_t **data;
3354 mus_long_t kp, samps = 0;
3355
3356 data = (mus_float_t **)malloc(1 * sizeof(mus_float_t *));
3357 data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
3358 ss->stopped_explicitly = false;
3359
3360 /* fprintf(stderr, "tempfile %d, %" print_mus_long " %s\n", __LINE__, num, DISPLAY(body)); */
3361 for (kp = 0; kp < num; kp++)
3362 {
3363 /* changed here to remove catch 24-Mar-02 */
3364 res = Xen_unprotected_call_with_1_arg(proc, C_double_to_Xen_real((double)read_sample(sf)));
3365 if (Xen_is_number(res)) /* one number -> replace current sample */
3366 {
3367 samps++;
3368 data[0][j++] = Xen_real_to_C_double(res);
3369 if (j == MAX_BUFFER_SIZE)
3370 {
3371 err = mus_file_write(ofd, 0, j - 1, 1, data);
3372 j = 0;
3373 if (err != MUS_NO_ERROR) break;
3374 }
3375 }
3376 else
3377 {
3378 if (!Xen_is_false(res)) /* if #f, no output on this pass */
3379 {
3380 if (Xen_is_true(res)) /* if #t we halt the entire map */
3381 break;
3382 else
3383 {
3384 if (mus_is_vct(res))
3385 {
3386 vct *v;
3387 mus_long_t vlen;
3388 mus_float_t *vdata;
3389
3390 v = Xen_to_vct(res);
3391 vlen = mus_vct_length(v);
3392 vdata = mus_vct_data(v);
3393
3394 for (i = 0; i < vlen; i++)
3395 {
3396 data[0][j++] = vdata[i];
3397 if (j == MAX_BUFFER_SIZE)
3398 {
3399 err = mus_file_write(ofd, 0, j - 1, 1, data);
3400 j = 0;
3401 if (err != MUS_NO_ERROR) break;
3402 }
3403 }
3404 samps += vlen - 1;
3405 }
3406 else
3407 {
3408 close_temp_file(filename, ofd, hdr->type, samps * datumb);
3409 sf = free_snd_fd(sf);
3410 if (reporting) finish_progress_report(cp);
3411 snd_remove(filename, REMOVE_FROM_CACHE);
3412 free(filename);
3413 free(data[0]);
3414 free(data);
3415
3416 Xen_error(BAD_TYPE,
3417 Xen_list_3(C_string_to_Xen_string("~A: result of procedure must be a (non-complex) number, boolean, or vct: ~A"),
3418 C_string_to_Xen_string(caller),
3419 res));
3420 }
3421 }
3422 }
3423 }
3424 if (reporting)
3425 {
3426 rpt++;
3427 if (rpt > rpt4)
3428 {
3429 progress_report(cp, (mus_float_t)((double)kp / (double)num));
3430 if (!(sp->active))
3431 {
3432 ss->stopped_explicitly = true;
3433 break;
3434 }
3435 rpt = 0;
3436 }
3437 }
3438 if (ss->stopped_explicitly) break;
3439 }
3440
3441 if (j > 0)
3442 mus_file_write(ofd, 0, j - 1, 1, data);
3443
3444 close_temp_file(filename, ofd, hdr->type, samps * datumb);
3445 free_file_info(hdr);
3446 free(data[0]);
3447 free(data);
3448 free_snd_fd(sf);
3449
3450 if (reporting) finish_progress_report(cp);
3451 if (ss->stopped_explicitly)
3452 ss->stopped_explicitly = false;
3453 else
3454 {
3455 if (cp->active < CHANNEL_HAS_EDIT_LIST)
3456 {
3457 snd_remove(filename, REMOVE_FROM_CACHE);
3458 free(filename);
3459 Xen_error(NO_SUCH_CHANNEL,
3460 Xen_list_2(C_string_to_Xen_string("~A: can't edit closed channel!"),
3461 C_string_to_Xen_string(caller)));
3462 return(Xen_false);
3463 }
3464
3465 if (samps == num)
3466 file_change_samples(beg, samps, filename, cp, 0, DELETE_ME, caller, pos);
3467 else
3468 {
3469 delete_samples(beg, num, cp, pos);
3470 if (samps > 0)
3471 {
3472 int cured;
3473 cured = cp->edit_ctr;
3474 file_insert_samples(beg, samps, filename, cp, 0, DELETE_ME, caller, cp->edit_ctr);
3475 backup_edit_list(cp);
3476 if (cp->edit_ctr > cured)
3477 backup_edit_list(cp);
3478 ripple_trailing_marks(cp, beg, num, samps);
3479 }
3480 else snd_remove(filename, REMOVE_FROM_CACHE);
3481 }
3482 }
3483 }
3484 free(filename);
3485 return(res);
3486 }
3487
3488 #if HAVE_SCHEME
tree_memq(s7_scheme * sc,s7_pointer symbol,s7_pointer tree)3489 static bool tree_memq(s7_scheme *sc, s7_pointer symbol, s7_pointer tree)
3490 {
3491 if (symbol == tree)
3492 return(true);
3493 if (s7_is_pair(tree))
3494 return((tree_memq(sc, symbol, s7_car(tree))) ||
3495 (tree_memq(sc, symbol, s7_cdr(tree))));
3496 return(false);
3497 }
3498
3499 static s7_pointer gc_vect;
3500 enum {GC_BODY, GC_ARGS, GC_FUNC, GC_LET};
3501 #endif
3502
map_channel_to_buffer(chan_info * cp,snd_fd * sf,Xen proc,mus_long_t beg,mus_long_t num,int pos,const char * caller)3503 static Xen map_channel_to_buffer(chan_info *cp, snd_fd *sf, Xen proc, mus_long_t beg, mus_long_t num, int pos, const char *caller)
3504 {
3505 /* not temp_file -- use resizable buffer */
3506 int i, data_pos = 0, kp;
3507 mus_long_t cur_size;
3508 mus_float_t *data = NULL;
3509 Xen res = Xen_false;
3510
3511 #if HAVE_SCHEME
3512 mus_float_t *in_data;
3513 bool use_apply;
3514 s7_pointer arg_list, body, e, slot;
3515
3516 arg_list = xen_nil;
3517 e = xen_nil;
3518 slot = xen_nil;
3519
3520 body = s7_closure_body(s7, proc);
3521 if ((s7_is_pair(body)) &&
3522 (s7_is_pair(s7_closure_args(s7, proc))))
3523 /* (!s7_tree_memq(s7, s7_make_symbol(s7, "set!"), body))) why this? */
3524 {
3525 s7_pointer arg;
3526 if (s7_is_null(s7, s7_cdr(body)))
3527 {
3528 res = s7_car(body);
3529 arg = s7_car(s7_closure_args(s7, proc));
3530 if (s7_is_pair(arg)) arg = s7_car(arg); /* lambda* + default */
3531
3532 if ((s7_is_boolean(res)) ||
3533 (res == arg))
3534 {
3535 /* #f = delete all samples in the range, #t = no-op, (lambda (y) y) a no-op */
3536 free_snd_fd(sf);
3537 if (res == s7_f(s7))
3538 delete_samples(beg, num, cp, pos);
3539 return(res);
3540 }
3541
3542 if (!s7_is_pair(res))
3543 {
3544 s7_double x;
3545 if (s7_is_symbol(res))
3546 {
3547 s7_pointer old_e;
3548 e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
3549 old_e = s7_set_curlet(s7, e); /* new env for map lambda */
3550 res = s7_symbol_value(s7, res);
3551 s7_set_curlet(s7, old_e);
3552 }
3553 x = s7_number_to_real_with_caller(s7, res, "map-channel");
3554 data = (mus_float_t *)malloc(num * sizeof(mus_float_t));
3555 for (kp = 0; kp < num; kp++)
3556 data[kp] = x;
3557 /* since we're not calling eval or the event checker, the channel can't be closed during the loop (??) */
3558 change_samples(beg, num, data, cp, caller, pos, fabs(x));
3559 free(data);
3560 free_snd_fd(sf);
3561 return(res);
3562 }
3563
3564 /* look first for the common scaling case */
3565 if ((s7_list_length(s7, res) == 3) &&
3566 (s7_cadr(res) != s7_caddr(res)) &&
3567 ((s7_car(res) == s7_make_symbol(s7, "*")) || (s7_car(res) == s7_make_symbol(s7, "+"))) &&
3568 (((s7_cadr(res) == arg) && (!s7_is_pair(s7_caddr(res)))) ||
3569 ((s7_caddr(res) == arg) && (!s7_is_pair(s7_cadr(res))))))
3570 {
3571 double x;
3572 s7_pointer fx;
3573 if (s7_cadr(res) == arg) fx = s7_caddr(res); else fx = s7_cadr(res);
3574 if (s7_is_symbol(fx))
3575 {
3576 s7_pointer old_e;
3577 e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
3578 old_e = s7_set_curlet(s7, e); /* new env for map lambda */
3579 fx = s7_symbol_value(s7, fx);
3580 s7_set_curlet(s7, old_e);
3581 }
3582 x = s7_number_to_real_with_caller(s7, fx, "map-channel");
3583 if (s7_car(res) == s7_make_symbol(s7, "*"))
3584 scale_channel(cp, x, beg, num, pos, NOT_IN_AS_ONE_EDIT);
3585 else
3586 {
3587 data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
3588 samples_to_vct_with_reader(num, data, sf);
3589 for (kp = 0; kp < num; kp++) data[kp] += x;
3590 change_samples(beg, num, data, cp, caller, pos, -1.0);
3591 free(data);
3592 }
3593 free_snd_fd(sf);
3594 return(res);
3595 }
3596
3597 {
3598 /* try s7_float_optimize */
3599 s7_pointer e, yp, old_e;
3600 s7_float_function opt_func;
3601 e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
3602 old_e = s7_set_curlet(s7, e);
3603 yp = s7_make_slot(s7, e, arg, s7_make_mutable_real(s7, 1.5));
3604
3605 opt_func = s7_float_optimize(s7, body);
3606 if (opt_func)
3607 {
3608 data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
3609 if (tree_memq(s7, arg, res))
3610 {
3611 samples_to_vct_with_reader(num, data, sf);
3612 for (kp = 0; kp < num; kp++)
3613 {
3614 s7_slot_set_real_value(s7, yp, data[kp]);
3615 data[kp] = opt_func(s7, res);
3616 }
3617 }
3618 else
3619 {
3620 for (kp = 0; kp < num; kp++)
3621 data[kp] = opt_func(s7, res);
3622 }
3623 free_snd_fd(sf);
3624 change_samples(beg, num, data, cp, caller, pos, -1.0);
3625 free(data);
3626 s7_set_curlet(s7, old_e);
3627 return(res);
3628 }
3629 }
3630
3631 if ((s7_list_length(s7, res) == 2) &&
3632 (s7_is_symbol(s7_cadr(res))))
3633 {
3634 if (s7_car(res) == s7_make_symbol(s7, "granulate"))
3635 {
3636 s7_pointer gp;
3637 mus_any *g;
3638 gp = s7_symbol_value(s7, s7_cadr(res));
3639 if ((mus_is_xen(gp)) &&
3640 (mus_is_granulate(g = Xen_to_mus_any(gp))))
3641 {
3642 data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
3643 for (kp = 0; kp < num; kp++)
3644 data[kp] = mus_granulate_with_editor(g, NULL, NULL);
3645 free_snd_fd(sf);
3646 change_samples(beg, num, data, cp, caller, pos, -1.0);
3647 free(data);
3648 return(res);
3649 }
3650 }
3651 if (s7_car(res) == s7_make_symbol(s7, "phase-vocoder"))
3652 {
3653 s7_pointer gp;
3654 mus_any *g;
3655 gp = s7_symbol_value(s7, s7_cadr(res));
3656 if ((mus_is_xen(gp)) &&
3657 (mus_is_phase_vocoder(g = Xen_to_mus_any(gp))))
3658 {
3659 data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
3660 for (kp = 0; kp < num; kp++)
3661 data[kp] = mus_phase_vocoder(g, NULL);
3662 free_snd_fd(sf);
3663 change_samples(beg, num, data, cp, caller, pos, -1.0);
3664 free(data);
3665 return(res);
3666 }
3667 }
3668 }
3669 } /* is one expr body */
3670
3671 arg = s7_car(s7_closure_args(s7, proc));
3672 e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
3673 s7_vector_set(s7, gc_vect, GC_LET, e);
3674 slot = s7_make_slot(s7, e, arg, s7_make_real(s7, 0.0));
3675 use_apply = false;
3676 if (s7_is_null(s7, s7_cdr(body)))
3677 {
3678 body = s7_car(body);
3679 }
3680 else
3681 {
3682 body = s7_cons(s7, s7_make_symbol(s7, "begin"), body);
3683 s7_vector_set(s7, gc_vect, GC_BODY, body);
3684 }
3685 /* fprintf(stderr, "eval %s\n", DISPLAY(body)); */
3686 }
3687 else
3688 {
3689 arg_list = Xen_list_1(Xen_false);
3690 s7_vector_set(s7, gc_vect, GC_ARGS, arg_list);
3691 use_apply = true;
3692 }
3693 s7_vector_set(s7, gc_vect, GC_FUNC, proc);
3694 #endif
3695
3696 /* fprintf(stderr, "map %" print_mus_long ": body: %s\n", num, s7_object_to_c_string(s7, body)); */
3697
3698 data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
3699 #if HAVE_SCHEME
3700 in_data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
3701 samples_to_vct_with_reader(num, in_data, sf);
3702 #endif
3703 cur_size = num;
3704 for (kp = 0; kp < num; kp++)
3705 {
3706 #if HAVE_SCHEME
3707 if (use_apply)
3708 {
3709 s7_set_car(arg_list, s7_make_real(s7, in_data[kp]));
3710 if (kp == 0)
3711 res = s7_call_with_location(s7, proc, arg_list, __func__, __FILE__, __LINE__);
3712 else res = s7_apply_function(s7, proc, arg_list);
3713 }
3714 else
3715 {
3716 s7_slot_set_value(s7, slot, s7_make_real(s7, in_data[kp]));
3717 res = s7_eval(s7, body, e);
3718 }
3719 #else
3720 res = Xen_unprotected_call_with_1_arg(proc, C_double_to_Xen_real((double)read_sample(sf)));
3721 #endif
3722
3723 if (Xen_is_number(res)) /* one number -> replace current sample */
3724 {
3725 if (data_pos >= cur_size)
3726 {
3727 cur_size *= 2;
3728 data = (mus_float_t *)realloc(data, cur_size * sizeof(mus_float_t));
3729 }
3730 data[data_pos++] = Xen_real_to_C_double(res);
3731 }
3732 else
3733 {
3734 if (!Xen_is_false(res)) /* if #f, no output on this pass */
3735 {
3736 if (Xen_is_true(res)) /* if #t we halt the entire map */
3737 break;
3738 else
3739 {
3740 if (mus_is_vct(res))
3741 {
3742 vct *v;
3743 mus_long_t vlen;
3744 mus_float_t *vdata;
3745
3746 v = Xen_to_vct(res);
3747 vlen = mus_vct_length(v);
3748 vdata = mus_vct_data(v);
3749
3750 for (i = 0; i < vlen; i++)
3751 {
3752 if (data_pos >= cur_size)
3753 {
3754 cur_size *= 2;
3755 data = (mus_float_t *)realloc(data, cur_size * sizeof(mus_float_t));
3756 }
3757 data[data_pos++] = vdata[i];
3758 }
3759 }
3760 else
3761 {
3762 if (data) {free(data); data = NULL;}
3763 sf = free_snd_fd(sf);
3764 #if HAVE_SCHEME
3765 free(in_data);
3766 #endif
3767 Xen_error(BAD_TYPE,
3768 Xen_list_3(C_string_to_Xen_string("~A: result of procedure must be a number, boolean, or vct: ~A"),
3769 C_string_to_Xen_string(caller),
3770 res));
3771 }
3772 }
3773 }
3774 }
3775 }
3776
3777 free_snd_fd(sf);
3778 #if HAVE_SCHEME
3779 free(in_data);
3780 #endif
3781
3782 if (cp->active < CHANNEL_HAS_EDIT_LIST)
3783 {
3784 if (data) {free(data); data = NULL;}
3785 Xen_error(NO_SUCH_CHANNEL,
3786 Xen_list_2(C_string_to_Xen_string("~A: can't edit closed channel!"),
3787 C_string_to_Xen_string(caller)));
3788 return(Xen_false);
3789 }
3790 if (data_pos == num)
3791 change_samples(beg, data_pos, data, cp, caller, pos, -1.0);
3792 else
3793 {
3794 /* the version above truncates to the new length... */
3795 delete_samples(beg, num, cp, pos);
3796 if (data_pos > 0)
3797 {
3798 int cured;
3799 cured = cp->edit_ctr;
3800 insert_samples(beg, data_pos, data, cp, caller, cp->edit_ctr);
3801 backup_edit_list(cp);
3802 if (cp->edit_ctr > cured)
3803 backup_edit_list(cp);
3804 ripple_trailing_marks(cp, beg, num, data_pos);
3805 }
3806 }
3807 if (data) {free(data); data = NULL;}
3808 return(res);
3809 }
3810
3811
g_map_chan_1(Xen proc_and_list,Xen s_beg,Xen s_end,Xen org,Xen snd,Xen chn,Xen edpos,Xen s_dur,const char * fallback_caller)3812 static Xen g_map_chan_1(Xen proc_and_list, Xen s_beg, Xen s_end, Xen org, Xen snd, Xen chn, Xen edpos, Xen s_dur, const char *fallback_caller)
3813 {
3814 chan_info *cp;
3815 const char *caller;
3816 mus_long_t beg = 0, end = 0, dur = 0;
3817 mus_long_t num;
3818 int pos;
3819 Xen res = Xen_false;
3820 Xen proc;
3821
3822 proc = proc_and_list;
3823
3824 if (Xen_is_string(org))
3825 caller = Xen_string_to_C_string(org);
3826 else caller = fallback_caller;
3827
3828 Xen_check_type((Xen_is_procedure(proc)) || (mus_is_xen(proc)), proc, 1, caller, "a procedure");
3829 Snd_assert_sample_type(caller, s_beg, 2);
3830 Snd_assert_sample_type(caller, s_end, 3);
3831 Snd_assert_sample_type(caller, s_dur, 3);
3832 Snd_assert_channel(caller, snd, chn, 5);
3833
3834 cp = get_cp(snd, chn, caller);
3835 if (!cp) return(Xen_false);
3836 if (!(is_editable(cp))) return(Xen_false);
3837
3838 pos = to_c_edit_position(cp, edpos, caller, 7);
3839 beg = beg_to_sample(s_beg, caller);
3840 if (Xen_is_false(s_dur))
3841 end = end_to_sample(s_end, cp, pos, caller);
3842 else dur = dur_to_samples(s_dur, beg, cp, pos, 3, caller); /* 3 is arg num from caller's point of view */
3843 if (end == 0)
3844 {
3845 if (dur != 0)
3846 end = beg + dur - 1;
3847 else end = cp->edits[pos]->samples - 1;
3848 }
3849 num = end - beg + 1;
3850 if (num > 0)
3851 {
3852 snd_fd *sf = NULL;
3853 char *errmsg;
3854 bool temp_file, backup = false;
3855
3856 errmsg = procedure_ok(proc, 1, caller, "", 1);
3857 if (errmsg)
3858 {
3859 Xen errstr;
3860 errstr = C_string_to_Xen_string(errmsg);
3861 free(errmsg);
3862 return(snd_bad_arity_error(caller, errstr, proc));
3863 }
3864
3865 /* added 27-Oct-06 -- can't see why map-channel should be that different from insert-samples et al */
3866 if (beg > cp->edits[pos]->samples)
3867 {
3868 if (!(extend_with_zeros(cp, cp->edits[pos]->samples, beg - cp->edits[pos]->samples, pos, "extend for " S_map_channel)))
3869 return(Xen_false);
3870 backup = true;
3871 pos = cp->edit_ctr;
3872 }
3873
3874 sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, (num > REPORTING_SIZE) ? REPORTING_SIZE : num);
3875 if (!sf)
3876 return(Xen_true);
3877
3878 temp_file = (num > REPORTING_SIZE);
3879 if (temp_file)
3880 res = map_channel_to_temp_file(cp, sf, proc, beg, num, pos, caller);
3881 else res = map_channel_to_buffer(cp, sf, proc, beg, num, pos, caller);
3882
3883 if (backup)
3884 backup_edit_list(cp);
3885
3886 update_graph(cp);
3887 }
3888 return(res);
3889 }
3890
3891
g_sp_scan(Xen proc_and_list,Xen s_beg,Xen s_end,Xen snd,Xen chn,const char * caller,bool counting,Xen edpos,int arg_pos,Xen s_dur)3892 static Xen g_sp_scan(Xen proc_and_list, Xen s_beg, Xen s_end, Xen snd, Xen chn, const char *caller, bool counting, Xen edpos, int arg_pos, Xen s_dur)
3893 {
3894 chan_info *cp;
3895 mus_long_t beg = 0, end = 0, dur = 0;
3896 snd_info *sp;
3897 snd_fd *sf;
3898 mus_long_t kp, num;
3899 int rpt = 0, rpt4 = 0;
3900 bool reporting = false;
3901 int counts = 0, pos;
3902 char *errmsg;
3903 Xen proc;
3904
3905 proc = proc_and_list;
3906
3907 Xen_check_type((Xen_is_procedure(proc)), proc, 1, caller, "a procedure");
3908 Snd_assert_sample_type(caller, s_beg, 2);
3909 Snd_assert_sample_type(caller, s_end, 3);
3910 Snd_assert_sample_type(caller, s_dur, 3);
3911 Snd_assert_channel(caller, snd, chn, 4);
3912
3913 cp = get_cp(snd, chn, caller);
3914 if (!cp) return(Xen_false);
3915
3916 pos = to_c_edit_position(cp, edpos, caller, arg_pos);
3917
3918 beg = beg_to_sample(s_beg, caller);
3919 if (beg > cp->edits[pos]->samples) return(Xen_false);
3920 if (Xen_is_false(s_dur))
3921 end = end_to_sample(s_end, cp, pos, caller);
3922 else dur = dur_to_samples(s_dur, beg, cp, pos, 3, caller);
3923
3924 errmsg = procedure_ok(proc, 1, caller, "", 1);
3925 if (errmsg)
3926 {
3927 Xen errstr;
3928 errstr = C_string_to_Xen_string(errmsg);
3929 free(errmsg);
3930 return(snd_bad_arity_error(caller, errstr, proc));
3931 }
3932 #if HAVE_SCHEME
3933 {
3934 Xen arity;
3935 arity = Xen_arity(proc);
3936 if (Xen_integer_to_C_int(Xen_car(arity)) != Xen_integer_to_C_int(Xen_cdr(arity)))
3937 return(snd_bad_arity_error(caller, C_string_to_Xen_string("function should not accept optional arguments"), proc));
3938 }
3939 #endif
3940
3941 sp = cp->sound;
3942 if (end == 0)
3943 {
3944 if (dur != 0)
3945 end = beg + dur - 1;
3946 else end = cp->edits[pos]->samples - 1;
3947 }
3948 num = end - beg + 1;
3949 if (num <= 0) return(Xen_false);
3950 sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, (num < REPORTING_SIZE) ? REPORTING_SIZE : num);
3951 if (!sf) return(Xen_true);
3952 sampler_set_safe(sf, num);
3953
3954 #if HAVE_SCHEME
3955 {
3956 s7_pointer arg_list;
3957 /* s7_int gc_loc; */
3958 bool use_apply;
3959 s7_pointer body, e, slot;
3960
3961 arg_list = xen_nil;
3962 e = xen_nil;
3963 slot = xen_nil;
3964
3965 body = s7_closure_body(s7, proc);
3966 if ((s7_is_pair(body)) &&
3967 (s7_is_pair(s7_closure_args(s7, proc))))
3968 /* (!s7_tree_memq(s7, s7_make_symbol(s7, "set!"), body))) */
3969 {
3970 s7_pointer arg, expr;
3971
3972 arg = s7_car(s7_closure_args(s7, proc));
3973 if (s7_is_pair(arg)) arg = s7_car(arg);
3974 expr = s7_car(body);
3975
3976 if (expr == xen_false)
3977 {
3978 free_snd_fd(sf);
3979 return(xen_false);
3980 }
3981 if (!s7_is_pair(expr))
3982 {
3983 free_snd_fd(sf);
3984 return(s_beg);
3985 }
3986
3987 e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
3988
3989 {
3990 s7_pointer res, yp, old_e, y, val;
3991 s7_function func;
3992
3993 old_e = s7_set_curlet(s7, e); /* new env for scan lambda */
3994 y = s7_make_mutable_real(s7, 1.5); /* slot for the scan lambda arg */
3995 yp = s7_make_slot(s7, e, arg, y);
3996 val = y;
3997 res = s7_car(body);
3998
3999 if (s7_is_null(s7, s7_cdr(body)))
4000 func = s7_optimize(s7, body);
4001 else func = s7_optimize(s7, s7_cons(s7, s7_cons(s7, s7_make_symbol(s7, "begin"), body), s7_nil(s7)));
4002 if (func)
4003 {
4004 for (kp = 0; kp < num; kp++)
4005 {
4006 s7_slot_set_real_value(s7, yp, read_sample(sf));
4007 val = func(s7, res);
4008
4009 if (val != s7_f(s7))
4010 {
4011 if (counting)
4012 counts++;
4013 else
4014 {
4015 if (reporting) finish_progress_report(cp);
4016 free_snd_fd(sf);
4017 s7_set_curlet(s7, old_e);
4018 return(C_llong_to_Xen_llong(kp + beg));
4019 }
4020 }
4021 }
4022 free_snd_fd(sf);
4023 s7_set_curlet(s7, old_e);
4024 if (counting)
4025 return(C_int_to_Xen_integer(counts));
4026 return(val);
4027 }
4028 s7_set_curlet(s7, old_e);
4029 }
4030
4031 s7_vector_set(s7, gc_vect, GC_LET, e);
4032 slot = s7_make_slot(s7, e, arg, s7_make_real(s7, 0.0));
4033 use_apply = false;
4034
4035 if (s7_is_null(s7, s7_cdr(body)))
4036 body = s7_car(body);
4037 else
4038 {
4039 body = s7_cons(s7, s7_make_symbol(s7, "begin"), body);
4040 s7_vector_set(s7, gc_vect, GC_BODY, body);
4041 }
4042 /* fprintf(stderr, "eval %s\n", DISPLAY(body)); */
4043 }
4044 else
4045 {
4046 /* is this for built-in funcs? */
4047 arg_list = Xen_list_1(Xen_false);
4048 s7_vector_set(s7, gc_vect, GC_ARGS, arg_list);
4049 use_apply = true;
4050 }
4051
4052 /* fprintf(stderr, "scan %" print_mus_long ": body: %s\n", num, s7_object_to_c_string(s7, body)); */
4053
4054 reporting = ((num > REPORTING_SIZE) && (!(cp->squelch_update)));
4055 if (reporting) start_progress_report(cp);
4056 rpt4 = MAX_BUFFER_SIZE / 4;
4057 ss->stopped_explicitly = false;
4058
4059 for (kp = 0; kp < num; kp++)
4060 {
4061 Xen res;
4062 if (use_apply)
4063 {
4064 s7_set_car(arg_list, s7_make_real(s7, read_sample(sf)));
4065 if (kp == 0)
4066 res = s7_call_with_location(s7, proc, arg_list, __func__, __FILE__, __LINE__);
4067 else res = s7_apply_function(s7, proc, arg_list);
4068 }
4069 else
4070 {
4071 s7_slot_set_value(s7, slot, s7_make_real(s7, read_sample(sf)));
4072 res = s7_eval(s7, body, e);
4073 }
4074
4075 #else
4076 for (kp = 0; kp < num; kp++)
4077 {
4078 Xen res;
4079 res = Xen_unprotected_call_with_1_arg(proc, C_double_to_Xen_real((double)read_sample(sf)));
4080 #endif
4081 /* leak here -- if reader active and error occurs, we jump out without cleanup */
4082 /* see dynamic_wind above */
4083 if (!Xen_is_false(res))
4084 {
4085 if ((counting) &&
4086 (Xen_is_true(res)))
4087 counts++;
4088 else
4089 {
4090 free_snd_fd(sf);
4091 if (reporting)
4092 finish_progress_report(cp);
4093 return(C_llong_to_Xen_llong(kp + beg));
4094 }
4095 }
4096 if (reporting)
4097 {
4098 rpt++;
4099 if (rpt > rpt4)
4100 {
4101 progress_report(cp, (mus_float_t)((double)kp / (double)num));
4102 if (!(sp->active))
4103 {
4104 ss->stopped_explicitly = true;
4105 break;
4106 }
4107 rpt = 0;
4108 }
4109 }
4110 if (ss->stopped_explicitly)
4111 {
4112 ss->stopped_explicitly = false;
4113 status_report(sp, "%s stopped at sample %" print_mus_long, caller, kp + beg);
4114 break;
4115 }
4116 }
4117 #if HAVE_SCHEME
4118 }
4119 #endif
4120 if (reporting) finish_progress_report(cp);
4121 free_snd_fd(sf);
4122 if (counting)
4123 return(C_int_to_Xen_integer(counts));
4124
4125 return(Xen_false);
4126 }
4127
4128
4129 mus_long_t scan_channel(chan_info *cp, mus_long_t start, mus_long_t end, Xen proc)
4130 {
4131 Xen result;
4132 result = g_sp_scan(proc, C_llong_to_Xen_llong(start), C_llong_to_Xen_llong(end),
4133 Xen_false, Xen_false, "search procedure", false, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0, Xen_false);
4134 if (Xen_is_llong(result))
4135 return(Xen_llong_to_C_llong(result));
4136 return(-1);
4137 }
4138
4139 #if (!HAVE_SCHEME)
4140 static Xen g_scan_chan(Xen proc, Xen beg, Xen end, Xen snd, Xen chn, Xen edpos)
4141 {
4142 #if HAVE_SCHEME
4143 #define scan_chan_example "(scan-chan (lambda (y) (> y .1)))"
4144 #endif
4145 #if HAVE_RUBY
4146 #define scan_chan_example "scan_chan(lambda do |y| y > 0.1 end)"
4147 #endif
4148 #if HAVE_FORTH
4149 #define scan_chan_example "lambda: <{ y }> y 0.1 f> ; scan-chan"
4150 #endif
4151
4152 #define H_scan_chan "(" S_scan_chan " func :optional (start 0) (end len) snd chn edpos): \
4153 apply 'func' to samples in current channel (or the specified channel). \
4154 'func' is a function of one argument, the current sample. \
4155 if 'func' returns non-" PROC_FALSE ", the scan stops, and the current sample number is returned.\n " scan_chan_example
4156
4157 Snd_assert_channel(S_scan_chan, snd, chn, 4);
4158
4159 #if HAVE_SCHEME
4160 {
4161 s7_pointer result;
4162 s7_vector_set(s7, gc_vect, GC_FUNC, proc);
4163 result = g_sp_scan(proc, beg, end, snd, chn, S_scan_chan, false, edpos, 6, Xen_false);
4164 return(result);
4165 }
4166 #else
4167 return(g_sp_scan(proc, beg, end, snd, chn, S_scan_chan, false, edpos, 6, Xen_false));
4168 #endif
4169 }
4170 #endif
4171
4172 static Xen g_scan_channel(Xen proc, Xen beg, Xen dur, Xen snd, Xen chn, Xen edpos)
4173 {
4174 #if HAVE_SCHEME
4175 #define scan_channel_example "(scan-channel (lambda (y) (> y .1)))"
4176 #endif
4177 #if HAVE_RUBY
4178 #define scan_channel_example "scan_channel(lambda do |y| y > 0.1 end)"
4179 #endif
4180 #if HAVE_FORTH
4181 #define scan_channel_example "lambda: <{ y }> y 0.1 f> ; scan-channel"
4182 #endif
4183
4184 #define H_scan_channel "(" S_scan_channel " func :optional (start 0) (dur len) snd chn edpos): \
4185 apply func to samples in current channel (or the specified channel). \
4186 func is a function of one argument, the current sample. \
4187 if func returns non-" PROC_FALSE ", the scan stops, and the current sample number is returned. \n " scan_channel_example
4188
4189 Snd_assert_channel(S_scan_channel, snd, chn, 4);
4190
4191 #if HAVE_SCHEME
4192 {
4193 s7_pointer result;
4194 s7_vector_set(s7, gc_vect, GC_FUNC, proc);
4195 result = g_sp_scan(proc, beg, Xen_false, snd, chn, S_scan_channel, false, edpos, 6, (Xen_is_bound(dur)) ? dur : Xen_false);
4196 return(result);
4197 }
4198 #else
4199 return(g_sp_scan(proc, beg, Xen_false, snd, chn, S_scan_channel, false, edpos, 6, (Xen_is_bound(dur)) ? dur : Xen_false));
4200 #endif
4201 }
4202
4203
4204 #if (!HAVE_SCHEME)
4205 static Xen g_map_chan(Xen proc, Xen s_beg, Xen s_end, Xen org, Xen snd, Xen chn, Xen edpos)
4206 {
4207 #if HAVE_SCHEME
4208 #define map_chan_example "(map-chan (lambda (y) (* y 2.0)))"
4209 #endif
4210 #if HAVE_RUBY
4211 #define map_chan_example "map_chan(lambda do |y| y * 2.0 end)"
4212 #endif
4213 #if HAVE_FORTH
4214 #define map_chan_example "lambda: <{ y }> y 2.0 f* ; map-chan"
4215 #endif
4216
4217 #define H_map_chan "(" S_map_chan " func :optional (start 0) (end len) edname snd chn edpos): \
4218 apply func to samples in current channel; edname is the edit history name for this editing operation.\n " map_chan_example
4219
4220 #if HAVE_SCHEME
4221 {
4222 s7_pointer result;
4223 s7_vector_set(s7, gc_vect, GC_FUNC, proc);
4224 result = g_map_chan_1(proc, s_beg, s_end, org, snd, chn, edpos, Xen_false, S_map_chan);
4225 return(result);
4226 }
4227 #else
4228 return(g_map_chan_1(proc, s_beg, s_end, org, snd, chn, edpos, Xen_false, S_map_chan));
4229 #endif
4230 }
4231 #endif
4232
4233
4234 static Xen g_map_channel(Xen proc, Xen s_beg, Xen s_dur, Xen snd, Xen chn, Xen edpos, Xen org)
4235 {
4236 #if HAVE_SCHEME
4237 #define map_channel_example "(map-channel (lambda (y) (* y 2.0)))"
4238 #endif
4239 #if HAVE_RUBY
4240 #define map_channel_example "map_channel(lambda do |y| y * 2.0 end)"
4241 #endif
4242 #if HAVE_FORTH
4243 #define map_channel_example "lambda: <{ y }> y 2.0 f* ; map-channel"
4244 #endif
4245
4246 #define H_map_channel "(" S_map_channel " func :optional (start 0) (dur len) snd chn edpos edname): \
4247 apply func to samples in current channel; edname is the edit history name for this editing operation.\n " map_channel_example
4248
4249 #if HAVE_SCHEME
4250 {
4251 s7_pointer result;
4252 s7_vector_set(s7, gc_vect, GC_FUNC, proc);
4253 result = g_map_chan_1(proc, s_beg, Xen_false, org, snd, chn, edpos, (Xen_is_bound(s_dur)) ? s_dur : Xen_false, S_map_channel);
4254 return(result);
4255 }
4256 #else
4257 return(g_map_chan_1(proc, s_beg, Xen_false, org, snd, chn, edpos, (Xen_is_bound(s_dur)) ? s_dur : Xen_false, S_map_channel));
4258 #endif
4259 }
4260
4261
4262 #if (!HAVE_SCHEME)
4263 static Xen g_find_channel(Xen expr, Xen sample, Xen snd, Xen chn_n, Xen edpos)
4264 {
4265 #if HAVE_SCHEME
4266 #define find_channel_example "(find-channel (lambda (y) (> y .1)))"
4267 #endif
4268 #if HAVE_RUBY
4269 #define find_channel_example "find_channel(lambda do |y| y > 0.1 end)"
4270 #endif
4271 #if HAVE_FORTH
4272 #define find_channel_example "lambda: <{ y }> y 0.1 f> ; find-channel"
4273 #endif
4274
4275 #define H_find_channel "(" S_find_channel " func :optional (start-samp 0) snd chn edpos): apply func, a function of one argument, \
4276 the current sample, to each sample in snd's channel chn, starting at 'start-samp' until func returns something other than " PROC_FALSE ": \n " find_channel_example
4277
4278 /* no free here -- it's handled as ss->search_expr in snd-find.c */
4279 Snd_assert_channel(S_find_channel, snd, chn_n, 3);
4280 return(g_sp_scan(expr, sample, Xen_false, snd, chn_n, S_find_channel, false, edpos, 5, Xen_false));
4281 }
4282 #endif
4283
4284
4285 static Xen g_count_matches(Xen expr, Xen sample, Xen snd, Xen chn_n, Xen edpos)
4286 {
4287 #if HAVE_SCHEME
4288 #define count_matches_example "(count-matches (lambda (y) (> y .1)))"
4289 #endif
4290 #if HAVE_RUBY
4291 #define count_matches_example "count_matches(lambda do |y| y > 0.1 end)"
4292 #endif
4293 #if HAVE_FORTH
4294 #define count_matches_example "lambda: <{ y }> y 0.1 f> ; count-matches"
4295 #endif
4296
4297 #define H_count_matches "(" S_count_matches " func :optional (start-samp 0) snd chn edpos): return how many \
4298 samples satisfy func (a function of one argument, the current sample, returning " PROC_TRUE " upon match):\n " count_matches_example
4299
4300 Snd_assert_channel(S_count_matches, snd, chn_n, 3);
4301 return(g_sp_scan(expr, sample, Xen_false, snd, chn_n, S_count_matches, true, edpos, 5, Xen_false));
4302 }
4303
4304
4305 static Xen g_smooth_sound(Xen beg, Xen num, Xen snd, Xen chn_n)
4306 {
4307 #define H_smooth_sound "(" S_smooth_sound " :optional (start-samp 0) (samps len) snd chn): smooth \
4308 data from start-samp for samps in snd's channel chn"
4309 chan_info *cp;
4310 mus_long_t start, samps;
4311
4312 Snd_assert_sample_type(S_smooth_sound, beg, 1);
4313 Snd_assert_sample_type(S_smooth_sound, num, 2);
4314 Snd_assert_channel(S_smooth_sound, snd, chn_n, 3);
4315
4316 cp = get_cp(snd, chn_n, S_smooth_sound);
4317 if (!cp) return(Xen_false);
4318 start = beg_to_sample(beg, S_smooth_sound);
4319 samps = dur_to_samples(num, start, cp, cp->edit_ctr, 2, S_smooth_sound);
4320
4321 cos_smooth(cp, start, samps, OVER_SOUND);
4322
4323 return(beg);
4324 }
4325
4326
4327 static Xen g_smooth_channel(Xen beg, Xen dur, Xen snd, Xen chn_n, Xen edpos)
4328 {
4329 #define H_smooth_channel "(" S_smooth_channel " :optional (beg 0) (dur len) snd chn edpos): \
4330 smooth data from beg for dur in snd's channel chn"
4331 chan_info *cp;
4332 mus_long_t start, num;
4333 int pos;
4334
4335 Snd_assert_sample_type(S_smooth_channel, beg, 1);
4336 Snd_assert_sample_type(S_smooth_channel, dur, 2);
4337 Snd_assert_channel(S_smooth_channel, snd, chn_n, 3);
4338
4339 cp = get_cp(snd, chn_n, S_smooth_channel);
4340 if (!cp) return(Xen_false);
4341 pos = to_c_edit_position(cp, edpos, S_smooth_channel, 5);
4342 start = beg_to_sample(beg, S_smooth_channel);
4343 num = dur_to_samples(dur, start, cp, pos, 2, S_smooth_channel);
4344
4345 if ((start < cp->edits[pos]->samples) &&
4346 (num > 0))
4347 smooth_channel(cp, start, num, pos);
4348
4349 return(beg);
4350 }
4351
4352
4353 static Xen g_smooth_selection(void)
4354 {
4355 #define H_smooth_selection "(" S_smooth_selection "): smooth the data in the currently selected portion"
4356 chan_info *cp;
4357
4358 if (!(selection_is_active()))
4359 return(snd_no_active_selection_error(S_smooth_selection));
4360 cp = get_cp(Xen_false, Xen_false, S_smooth_selection);
4361 if (!cp) return(Xen_false);
4362
4363 cos_smooth(cp, 0, 0, OVER_SELECTION);
4364
4365 return(Xen_true);
4366 }
4367
4368
4369 static void cut_and_smooth_1(chan_info *cp, mus_long_t beg, mus_long_t end, bool over_selection, int pos)
4370 {
4371 #define SPLICE_LEN 32
4372 /* making this 128 is not a big improvement */
4373 mus_long_t start;
4374 mus_float_t splice[2 * SPLICE_LEN];
4375 double ramp, incr;
4376 int i;
4377 snd_fd *sf, *sf_end;
4378
4379 incr = 0.5 / SPLICE_LEN;
4380 if (end < SPLICE_LEN)
4381 start = 0;
4382 else start = end - SPLICE_LEN;
4383
4384 sf_end = init_sample_read_any_with_bufsize(start, cp, READ_FORWARD, pos, 2 * SPLICE_LEN);
4385
4386 if (beg < SPLICE_LEN)
4387 start = 0;
4388 else start = beg - SPLICE_LEN;
4389
4390 sf = init_sample_read_any_with_bufsize(start, cp, READ_FORWARD, pos, 2 * SPLICE_LEN);
4391 for (i = 0, ramp = 1.0; i < 2 * SPLICE_LEN; i++, ramp -= incr)
4392 {
4393 mus_float_t x, y;
4394 x = read_sample(sf);
4395 y = read_sample(sf_end);
4396 splice[i] = (x * ramp) + (y * (1.0 - ramp));
4397 }
4398 free_snd_fd(sf);
4399 free_snd_fd(sf_end);
4400
4401 if (over_selection)
4402 cp_delete_selection(cp);
4403 else delete_samples(beg, end - beg + 1, cp, pos);
4404
4405 change_samples(start, 2 * SPLICE_LEN, splice, cp,
4406 (over_selection) ? S_delete_selection_and_smooth : S_delete_samples_and_smooth,
4407 cp->edit_ctr, -1.0);
4408 }
4409
4410
4411 void cut_and_smooth(chan_info *cp)
4412 {
4413 if (selection_is_active_in_channel(cp))
4414 cut_and_smooth_1(cp, selection_beg(cp), selection_end(cp), true, cp->edit_ctr);
4415 }
4416
4417
4418 static Xen g_delete_selection_and_smooth(void)
4419 {
4420 #define H_delete_selection_and_smooth "(" S_delete_selection_and_smooth ") deletes the current selection, and tries to \
4421 make the splice-point smooth."
4422
4423 if (!(selection_is_active()))
4424 return(snd_no_active_selection_error(S_delete_selection_and_smooth));
4425 for_each_chan(cut_and_smooth);
4426 return(Xen_false);
4427 }
4428
4429
4430
4431 static Xen g_delete_samples_and_smooth(Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos)
4432 {
4433 #define H_delete_samples_and_smooth "(" S_delete_samples_and_smooth " start-samp samps :optional snd chn edpos): \
4434 delete 'samps' samples from snd's channel chn starting at 'start-samp', then try to smooth-over the splice"
4435
4436 chan_info *cp;
4437 int pos;
4438 mus_long_t samp, len;
4439
4440 Xen_check_type(Xen_is_integer(samp_n), samp_n, 1, S_delete_samples_and_smooth, "an integer");
4441 Xen_check_type(Xen_is_llong(samps), samps, 2, S_delete_samples_and_smooth, "an integer");
4442
4443 Snd_assert_channel(S_delete_samples_and_smooth, snd, chn_n, 3);
4444 cp = get_cp(snd, chn_n, S_delete_samples_and_smooth);
4445 if (!cp) return(Xen_false);
4446
4447 pos = to_c_edit_position(cp, edpos, S_delete_samples_and_smooth, 5);
4448 samp = beg_to_sample(samp_n, S_delete_samples_and_smooth);
4449 if (samp > cp->edits[pos]->samples)
4450 Xen_out_of_range_error(S_delete_samples_and_smooth, 1, samp_n, "beyond end of sound");
4451
4452 len = Xen_llong_to_C_llong(samps);
4453 if (len <= 0) return(Xen_false);
4454 if (len > cp->edits[pos]->samples)
4455 len = cp->edits[pos]->samples;
4456
4457 cut_and_smooth_1(cp, samp, samp + len - 1, false, pos);
4458 update_graph(cp);
4459 return(samp_n);
4460 }
4461
4462
4463
4464 static Xen g_reverse_sound(Xen snd, Xen chn_n, Xen edpos)
4465 {
4466 #define H_reverse_sound "(" S_reverse_sound " :optional snd chn edpos): reverse snd's channel chn"
4467 chan_info *cp;
4468
4469 Snd_assert_channel(S_reverse_sound, snd, chn_n, 1);
4470 cp = get_cp(snd, chn_n, S_reverse_sound);
4471 if (!cp) return(Xen_false);
4472
4473 reverse_sound(cp, OVER_SOUND, edpos, 3);
4474
4475 return(Xen_false);
4476 }
4477
4478
4479 static Xen g_reverse_selection(void)
4480 {
4481 #define H_reverse_selection "(" S_reverse_selection "): reverse the data in the currently selected portion"
4482 chan_info *cp;
4483
4484 if (!(selection_is_active()))
4485 return(snd_no_active_selection_error(S_reverse_selection));
4486
4487 cp = get_cp(Xen_false, Xen_false, S_reverse_selection);
4488 if (!cp) return(Xen_false);
4489
4490 reverse_sound(cp, OVER_SELECTION, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
4491
4492 return(Xen_false);
4493 }
4494
4495
4496 static Xen g_reverse_channel(Xen s_beg, Xen s_dur, Xen snd, Xen chn_n, Xen edpos)
4497 {
4498 #define H_reverse_channel "(" S_reverse_channel " :optional (beg 0) (dur len) snd chn edpos): reverse a portion of snd's channel chn"
4499 chan_info *cp;
4500 char *errmsg;
4501 mus_long_t beg = 0, dur = 0, end;
4502 int pos;
4503 snd_fd *sf;
4504
4505 Snd_assert_sample_type(S_reverse_channel, s_beg, 1);
4506 Snd_assert_sample_type(S_reverse_channel, s_dur, 2);
4507 Snd_assert_channel(S_reverse_channel, snd, chn_n, 3);
4508
4509 cp = get_cp(snd, chn_n, S_reverse_channel);
4510 if (!cp) return(Xen_false);
4511 beg = beg_to_sample(s_beg, S_reverse_channel);
4512 pos = to_c_edit_position(cp, edpos, S_reverse_channel, 5);
4513 dur = dur_to_samples(s_dur, beg, cp, pos, 2, S_reverse_channel);
4514 if ((beg > cp->edits[pos]->samples) || (dur == 0)) return(Xen_false);
4515 end = beg + dur;
4516 if (end > cp->edits[pos]->samples)
4517 end = cp->edits[pos]->samples;
4518
4519 sf = init_sample_read_any(end - 1, cp, READ_BACKWARD, pos);
4520 errmsg = reverse_channel(cp, sf, beg, end - beg, edpos, S_reverse_channel, 5);
4521
4522 free_snd_fd(sf);
4523 if (errmsg)
4524 {
4525 Xen str;
4526 str = C_string_to_Xen_string(errmsg);
4527 free(errmsg);
4528 Xen_error(Xen_make_error_type("IO-error"),
4529 Xen_list_2(C_string_to_Xen_string(S_reverse_channel ": IO error ~A"),
4530 str));
4531 }
4532 return(s_beg);
4533 }
4534
4535
4536 static Xen g_insert_silence(Xen beg, Xen num, Xen snd, Xen chn)
4537 {
4538 #define H_insert_silence "(" S_insert_silence " beg num :optional snd chn): insert num zeros at beg in snd's chn"
4539 chan_info *cp; /* follows sync */
4540 mus_long_t start = 0, len = 0;
4541
4542 Xen_check_type(Xen_is_integer(beg), beg, 1, S_insert_silence, "an integer");
4543 Xen_check_type(Xen_is_integer(num), num, 2, S_insert_silence, "an integer");
4544 Snd_assert_channel(S_insert_silence, snd, chn, 3);
4545
4546 cp = get_cp(snd, chn, S_insert_silence);
4547 if (!cp) return(Xen_false);
4548
4549 start = beg_to_sample(beg, S_insert_silence);
4550 len = Xen_llong_to_C_llong(num);
4551 if (len <= 0) return(Xen_false);
4552 if (len > (1LL << 34))
4553 Xen_out_of_range_error(S_insert_silence, 2, num, "too large");
4554
4555 cursor_insert(cp, start, len);
4556
4557 return(beg);
4558 }
4559
4560
4561 static Xen g_pad_channel(Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
4562 {
4563 #define H_pad_channel "(" S_pad_channel " beg dur :optional snd chn edpos): insert dur zeros at beg in snd's chn"
4564 chan_info *cp;
4565 mus_long_t bg, len;
4566 int pos;
4567
4568 Xen_check_type(Xen_is_integer(beg), beg, 1, S_pad_channel, "an integer");
4569 Xen_check_type(Xen_is_integer(num), num, 2, S_pad_channel, "an integer");
4570 Snd_assert_channel(S_pad_channel, snd, chn, 3);
4571
4572 cp = get_cp(snd, chn, S_pad_channel);
4573 if (!cp) return(Xen_false);
4574
4575 bg = beg_to_sample(beg, S_pad_channel);
4576
4577 len = Xen_llong_to_C_llong(num);
4578 if (len <= 0) return(Xen_false); /* to parallel insert-silence above -- maybe better would be an out of range error in both cases */
4579 if (len > (1LL << 34))
4580 Xen_out_of_range_error(S_pad_channel, 2, num, "too large");
4581
4582 pos = to_c_edit_position(cp, edpos, S_pad_channel, 5);
4583
4584 if ((len > 0) &&
4585 (extend_with_zeros(cp, bg, len, pos, S_pad_channel)))
4586 update_graph(cp);
4587 return(beg);
4588 }
4589
4590
4591 static Xen g_swap_channels(Xen snd0, Xen chn0, Xen snd1, Xen chn1, Xen beg, Xen dur, Xen edpos0, Xen edpos1)
4592 {
4593 #define H_swap_channels "(" S_swap_channels " :optional snd0 chn0 snd1 chn1 (beg 0) (dur len) edpos0 edpos1): \
4594 swap the indicated channels"
4595 chan_info *cp0 = NULL, *cp1 = NULL;
4596 snd_info *sp = NULL;
4597
4598 Snd_assert_channel(S_swap_channels, snd0, chn0, 1);
4599
4600 cp0 = get_cp(snd0, chn0, S_swap_channels);
4601 if (!cp0) return(Xen_false);
4602 if (!(cp0->editable)) return(Xen_false);
4603
4604 if (Xen_is_integer(chn1))
4605 {
4606 Snd_assert_channel(S_swap_channels, snd1, chn1, 3);
4607 cp1 = get_cp(snd1, chn1, S_swap_channels);
4608 }
4609 else
4610 {
4611 if (Xen_is_integer(snd1) || xen_is_sound(snd1))
4612 sp = get_sp(snd1);
4613 else sp = cp0->sound;
4614 if (!sp)
4615 return(snd_no_such_sound_error(S_swap_channels, snd1));
4616 if (cp0->sound == sp)
4617 {
4618 if ((cp0->chan + 1) < (int)sp->nchans)
4619 cp1 = sp->chans[cp0->chan + 1];
4620 else cp1 = sp->chans[0];
4621 }
4622 else cp1 = sp->chans[0];
4623 }
4624
4625 if (cp0 == cp1) return(Xen_false);
4626 if (!(cp1->editable)) return(Xen_false);
4627 if ((cp0) && (cp1))
4628 {
4629 int pos0, pos1;
4630 mus_long_t dur0, dur1, beg0 = 0, num;
4631
4632 if (Xen_is_integer(beg))
4633 beg0 = Xen_llong_to_C_llong(beg);
4634
4635 pos0 = to_c_edit_position(cp0, edpos0, S_swap_channels, 7);
4636 pos1 = to_c_edit_position(cp1, edpos1, S_swap_channels, 8);
4637
4638 dur0 = cp0->edits[pos0]->samples;
4639 dur1 = cp1->edits[pos1]->samples;
4640
4641 if (Xen_is_integer(dur))
4642 num = Xen_llong_to_C_llong(dur);
4643 else
4644 {
4645 if (dur0 > dur1)
4646 num = dur0;
4647 else num = dur1; /* was min here 13-Dec-02 */
4648 }
4649
4650 if ((beg0 != 0) ||
4651 ((num != dur0) && (num != dur1))) /* if just a section being swapped, use readers */
4652 swap_channels(cp0, cp1, beg0, num, pos0, pos1);
4653
4654 else
4655 {
4656 if ((pos0 == 0) &&
4657 (pos1 == 0))
4658 {
4659 /* common special case -- just setup a new ed-list entry with the channels/sounds swapped */
4660 if ((dur0 == 0) && (dur1 == 0)) return(Xen_false);
4661 if ((is_editable(cp0)) && (is_editable(cp1)))
4662 {
4663 peak_env_info *e0, *e1;
4664 e0 = peak_env_copy(cp0, false, cp0->edit_ctr);
4665 e1 = peak_env_copy(cp1, false, cp1->edit_ctr);
4666 file_override_samples(dur1, cp1->sound->filename, cp0, cp1->chan, DONT_DELETE_ME, S_swap_channels);
4667 file_override_samples(dur0, cp0->sound->filename, cp1, cp0->chan, DONT_DELETE_ME, S_swap_channels);
4668 cp0->edits[cp0->edit_ctr]->peak_env = e1; /* can be NULL */
4669 cp1->edits[cp1->edit_ctr]->peak_env = e0;
4670 swap_marks(cp0, cp1);
4671 update_graph(cp0);
4672 update_graph(cp1);
4673 }
4674 }
4675 else
4676 {
4677 /* look for simple cases where copying the current edit tree entry is not too hard */
4678 if ((num < FILE_BUFFER_SIZE) ||
4679 (sound_fragments_in_use(cp0, pos0)) ||
4680 (sound_fragments_in_use(cp1, pos1)))
4681 swap_channels(cp0, cp1, beg0, num, pos0, pos1);
4682 else copy_then_swap_channels(cp0, cp1, pos0, pos1); /* snd-edits.c */
4683 }
4684 }
4685 }
4686 return(Xen_false);
4687 }
4688
4689
4690 static mus_float_t *load_mus_float_ts(Xen scalers, int *result_len, const char *caller)
4691 {
4692 uint32_t len = 0, i;
4693 mus_float_t *scls;
4694 vct *v = NULL;
4695 if (Xen_is_number(scalers))
4696 len = 1;
4697 else
4698 {
4699 if (mus_is_vct(scalers))
4700 {
4701 v = Xen_to_vct(scalers);
4702 len = (uint32_t)mus_vct_length(v);
4703 }
4704 else
4705 {
4706 if (Xen_is_list(scalers))
4707 {
4708 int lst_len;
4709 lst_len = Xen_list_length(scalers);
4710 if (lst_len < 0)
4711 Xen_wrong_type_arg_error(caller, 1, scalers, "a proper list");
4712 len = (uint32_t)lst_len;
4713 }
4714 else Xen_wrong_type_arg_error(caller, 1, scalers, "a number, list, or " S_vct);
4715 }
4716
4717 if (len == 0)
4718 Xen_error(NO_DATA,
4719 Xen_list_2(C_string_to_Xen_string("~A: scalers data is empty?"),
4720 C_string_to_Xen_string(caller)));
4721 }
4722
4723 scls = (mus_float_t *)calloc(len, sizeof(mus_float_t));
4724 if (v)
4725 mus_copy_floats(scls, mus_vct_data(v), len);
4726 else
4727 {
4728 if (Xen_is_list(scalers))
4729 {
4730 Xen lst;
4731 for (i = 0, lst = Xen_copy_arg(scalers); i < len; i++, lst = Xen_cdr(lst))
4732 scls[i] = (mus_float_t)Xen_real_to_C_double(Xen_car(lst));
4733 }
4734 else scls[0] = (mus_float_t)Xen_real_to_C_double(scalers);
4735 }
4736 result_len[0] = len;
4737 return(scls);
4738 }
4739
4740
4741 static Xen g_scale_to(Xen scalers, Xen snd, Xen chn_n)
4742 {
4743 #define H_scale_to "(" S_scale_to " :optional (norms 1.0) snd chn): \
4744 normalize snd to norms (following sync); norms can be a float or a " S_vct "/list of floats"
4745
4746 /* chn_n irrelevant if sync */
4747 chan_info *cp;
4748 bool happy;
4749 int len[1];
4750 mus_float_t *scls;
4751
4752 Snd_assert_channel(S_scale_to, snd, chn_n, 2);
4753 cp = get_cp(snd, chn_n, S_scale_to);
4754 if (!cp) return(Xen_false);
4755
4756 scls = load_mus_float_ts(scalers, len, S_scale_to);
4757 happy = scale_to(cp->sound, cp, scls, len[0], OVER_SOUND);
4758
4759 free(scls);
4760 if (happy)
4761 return(scalers);
4762 return(Xen_false);
4763 }
4764
4765
4766 static Xen g_scale_by(Xen scalers, Xen snd, Xen chn_n)
4767 {
4768 #define H_scale_by "(" S_scale_by " scalers :optional snd chn): \
4769 scale snd by scalers (following sync); scalers can be a float or a " S_vct "/list of floats"
4770
4771 /* chn_n irrelevant if sync */
4772 chan_info *cp;
4773 int len[1];
4774 mus_float_t *scls;
4775
4776 Snd_assert_channel(S_scale_by, snd, chn_n, 2);
4777 cp = get_cp(snd, chn_n, S_scale_by);
4778 if (!cp) return(Xen_false);
4779 len[0] = 0;
4780
4781 /* fprintf(stderr, "(scale-by %s %s %s)\n", Xen_object_to_C_string(scalers), Xen_object_to_C_string(snd), Xen_object_to_C_string(chn_n)); */
4782
4783 scls = load_mus_float_ts(scalers, len, S_scale_by);
4784 if (len[0] == 0)
4785 {
4786 /* fprintf(stderr, "len is 0\n"); */
4787 return(Xen_false);
4788 }
4789 scale_by(cp, scls, len[0], OVER_SOUND);
4790
4791 free(scls);
4792 return(scalers);
4793 }
4794
4795
4796 static Xen g_scale_selection_to(Xen scalers)
4797 {
4798 #define H_scale_selection_to "(" S_scale_selection_to " norms): normalize selected portion to norms"
4799 if (selection_is_active())
4800 {
4801 int len[1];
4802 bool happy;
4803 mus_float_t *scls;
4804
4805 scls = load_mus_float_ts(scalers, len, S_scale_selection_to);
4806 happy = scale_to(NULL, NULL, scls, len[0], OVER_SELECTION);
4807
4808 free(scls);
4809 if (happy)
4810 return(scalers);
4811 return(Xen_false);
4812 }
4813 return(snd_no_active_selection_error(S_scale_selection_to));
4814 }
4815
4816
4817 Xen g_scale_selection_by(Xen scalers)
4818 {
4819 #define H_scale_selection_by "(" S_scale_selection_by " scalers): scale selected portion by scalers"
4820 if (selection_is_active())
4821 {
4822 int len[1];
4823 mus_float_t *scls;
4824
4825 scls = load_mus_float_ts(scalers, len, S_scale_selection_by);
4826 scale_by(NULL, scls, len[0], OVER_SELECTION);
4827
4828 free(scls);
4829 return(scalers);
4830 }
4831 return(snd_no_active_selection_error(S_scale_selection_by));
4832 }
4833
4834
4835 static Xen g_clm_channel(Xen gen, Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos, Xen overlap, Xen origin)
4836 {
4837 #define H_clm_channel "(" S_clm_channel " gen :optional (beg 0) (dur len) snd chn edpos (overlap 0) origin): \
4838 apply gen to snd's channel chn starting at beg for dur samples. overlap is the 'ring' time, if any."
4839
4840 chan_info *cp;
4841 mus_long_t beg = 0, dur = 0;
4842 int pos;
4843 mus_any *egen;
4844 char *errmsg = NULL, *caller = NULL;
4845
4846 Snd_assert_sample_type(S_clm_channel, samp_n, 2);
4847 Snd_assert_sample_type(S_clm_channel, samps, 3);
4848 Xen_check_type(Xen_is_integer(overlap) || Xen_is_false(overlap) || !Xen_is_bound(overlap), overlap, 7, S_clm_channel, "an integer or " PROC_FALSE);
4849 Xen_check_type(Xen_is_string_or_unbound(origin), origin, 8, S_clm_channel, "a string");
4850 Snd_assert_channel(S_clm_channel, snd, chn_n, 4);
4851
4852 cp = get_cp(snd, chn_n, S_clm_channel);
4853 if (!cp) return(Xen_false);
4854 pos = to_c_edit_position(cp, edpos, S_clm_channel, 6);
4855 beg = beg_to_sample(samp_n, S_clm_channel);
4856 dur = dur_to_samples(samps, beg, cp, pos, 3, S_clm_channel);
4857 if (dur == 0) return(Xen_false);
4858 Xen_check_type(mus_is_xen(gen), gen, 1, S_clm_channel, "a clm generator");
4859 egen = Xen_to_mus_any(gen);
4860 if (Xen_is_string(origin)) caller = mus_strdup(Xen_string_to_C_string(origin)); else caller = mus_strdup(S_clm_channel);
4861
4862 errmsg = clm_channel(cp, egen, beg, dur, pos, (Xen_is_llong(overlap)) ? Xen_llong_to_C_llong(overlap) : 0, caller);
4863
4864 free(caller);
4865 if (errmsg)
4866 {
4867 Xen str;
4868 str = C_string_to_Xen_string(errmsg);
4869 free(errmsg);
4870 Xen_error(Xen_make_error_type("IO-error"),
4871 Xen_list_2(C_string_to_Xen_string(S_clm_channel ": IO error ~A"),
4872 str));
4873 }
4874 return(gen);
4875 }
4876
4877
4878 static Xen g_apply_env_1(Xen edata, mus_long_t beg, mus_long_t dur, Xen ebase, chan_info *cp, Xen edpos, const char *caller, bool over_selection)
4879 {
4880 if (Xen_is_list(edata))
4881 {
4882 env *e;
4883 e = get_env(edata, caller);
4884 if (e)
4885 {
4886 if (Xen_is_number(ebase))
4887 {
4888 /* env 'e' is a temp here, so we can clobber its base, etc */
4889 e->base = Xen_real_to_C_double(ebase);
4890 if (e->base < 0.0)
4891 {
4892 free_env(e);
4893 Xen_out_of_range_error(caller, 4, ebase, "base < 0.0?");
4894 }
4895 }
4896 apply_env(cp, e, beg, dur, over_selection, caller, NULL, edpos, 7);
4897 free_env(e);
4898 return(edata);
4899 }
4900 }
4901 else
4902 {
4903 mus_any *egen = NULL;
4904 Xen_check_type((mus_is_xen(edata)) && (mus_is_env(egen = Xen_to_mus_any(edata))), edata, 1, caller, "an env generator or a list");
4905 apply_env(cp, NULL, beg, dur, over_selection, caller, egen, edpos, 7);
4906 return(edata);
4907 }
4908 return(Xen_false);
4909 }
4910
4911
4912 static Xen g_env_selection(Xen edata, Xen base)
4913 {
4914 #define H_env_selection "(" S_env_selection " env :optional (env-base 1.0)): \
4915 apply envelope to the selection using env-base to determine how breakpoints are connected"
4916
4917 if (!(selection_is_active()))
4918 return(snd_no_active_selection_error(S_env_selection));
4919 return(g_apply_env_1(edata, 0, 0, base,
4920 get_cp(Xen_false, Xen_false, S_env_selection),
4921 C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION),
4922 S_env_selection, OVER_SELECTION));
4923 }
4924
4925
4926 static Xen g_env_sound(Xen edata, Xen samp_n, Xen samps, Xen base, Xen snd, Xen chn_n, Xen edpos)
4927 {
4928 #define H_env_sound "(" S_env_sound " env :optional (start-samp 0) (samps len) (env-base 1.0) snd chn edpos): \
4929 apply amplitude envelope (a list of breakpoints or a CLM env) to snd's channel chn starting at start-samp, going \
4930 either to the end of the sound or for samps samples, with segments interpolating according to env-base"
4931
4932 mus_long_t beg = 0, dur = 0;
4933 int pos;
4934 chan_info *cp;
4935
4936 Snd_assert_sample_type(S_env_sound, samp_n, 2);
4937 Snd_assert_sample_type(S_env_sound, samps, 3);
4938 Snd_assert_channel(S_env_sound, snd, chn_n, 5);
4939
4940 cp = get_cp(snd, chn_n, S_env_sound);
4941 if (!cp) return(Xen_false);
4942 pos = to_c_edit_position(cp, edpos, S_env_sound, 7);
4943 beg = beg_to_sample(samp_n, S_env_sound);
4944 dur = dur_to_samples(samps, beg, cp, pos, 3, S_env_sound);
4945
4946 return(g_apply_env_1(edata, beg, dur, base, cp, edpos, S_env_sound, OVER_SOUND));
4947 }
4948
4949
4950 static Xen g_env_channel(Xen gen, Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos)
4951 {
4952 #define H_env_channel "(" S_env_channel " clm-env-gen-or-envelope :optional (beg 0) (dur len) snd chn edpos): \
4953 apply amplitude envelope to snd's channel chn starting at beg for dur samples."
4954
4955 chan_info *cp;
4956 snd_info *sp;
4957 mus_long_t beg = 0, dur;
4958 int old_sync = 0, pos;
4959 Xen val;
4960
4961 Snd_assert_sample_type(S_env_channel, samp_n, 2);
4962 Snd_assert_sample_type(S_env_channel, samps, 3);
4963 Snd_assert_channel(S_env_channel, snd, chn_n, 4);
4964
4965 cp = get_cp(snd, chn_n, S_env_channel);
4966 if (!cp) return(Xen_false);
4967 beg = beg_to_sample(samp_n, S_env_channel);
4968 pos = to_c_edit_position(cp, edpos, S_env_channel, 6);
4969 dur = dur_to_samples(samps, beg, cp, pos, 3, S_env_channel);
4970 if (dur == 0) return(Xen_false);
4971 if (beg > cp->edits[pos]->samples) return(Xen_false); /* not redundant */
4972 sp = cp->sound;
4973 old_sync = sp->sync;
4974 sp->sync = 0;
4975
4976 val = g_apply_env_1(gen, beg, dur, Xen_false, cp, edpos, S_env_channel, OVER_SOUND);
4977
4978 sp->sync = old_sync;
4979 return(val);
4980 }
4981
4982
4983 static Xen g_env_channel_with_base(Xen gen, Xen base, Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos)
4984 {
4985 #define H_env_channel_with_base "(" S_env_channel_with_base " clm-env-gen-or-envelope :optional (base 1.0) (beg 0) (dur len) snd chn edpos): \
4986 apply amplitude envelope to snd's channel chn starting at beg for dur samples."
4987
4988 chan_info *cp;
4989 snd_info *sp;
4990 mus_long_t beg = 0, dur;
4991 int old_sync = 0, pos;
4992 Xen val;
4993
4994 Snd_assert_sample_type(S_env_channel, samp_n, 2);
4995 Snd_assert_sample_type(S_env_channel, samps, 3);
4996 Snd_assert_channel(S_env_channel, snd, chn_n, 4);
4997
4998 cp = get_cp(snd, chn_n, S_env_channel);
4999 if (!cp) return(Xen_false);
5000 beg = beg_to_sample(samp_n, S_env_channel);
5001 pos = to_c_edit_position(cp, edpos, S_env_channel, 6);
5002 dur = dur_to_samples(samps, beg, cp, pos, 3, S_env_channel);
5003 if (dur == 0) return(Xen_false);
5004 if (beg > cp->edits[pos]->samples) return(Xen_false); /* not redundant */
5005 sp = cp->sound;
5006 old_sync = sp->sync;
5007 sp->sync = 0;
5008
5009 val = g_apply_env_1(gen, beg, dur, base, cp, edpos, S_env_channel, OVER_SOUND);
5010
5011 sp->sync = old_sync;
5012 return(val);
5013 }
5014
5015
5016 static Xen g_ramp_channel(Xen rmp0, Xen rmp1, Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
5017 {
5018 #define H_ramp_channel "(" S_ramp_channel " rmp0 rmp1 :optional (beg 0) (dur len) snd chn edpos): \
5019 scale samples in the given sound/channel between beg and beg + num by a ramp going from rmp0 to rmp1."
5020
5021 chan_info *cp;
5022 mus_long_t samp, samps;
5023 int pos;
5024 double seg0, seg1;
5025
5026 Xen_check_type(Xen_is_number(rmp0), rmp0, 1, S_ramp_channel, "a number");
5027 Xen_check_type(Xen_is_number(rmp1), rmp1, 2, S_ramp_channel, "a number");
5028 Snd_assert_sample_type(S_ramp_channel, beg, 3);
5029 Snd_assert_sample_type(S_ramp_channel, num, 4);
5030 Snd_assert_sound(S_ramp_channel, snd, 5);
5031
5032 samp = beg_to_sample(beg, S_ramp_channel);
5033 cp = get_cp(snd, chn, S_ramp_channel);
5034 if (!cp) return(Xen_false);
5035 pos = to_c_edit_position(cp, edpos, S_ramp_channel, 7);
5036 samps = dur_to_samples(num, samp, cp, pos, 4, S_ramp_channel);
5037
5038 if (unrampable(cp, samp, samps, pos, false)) /* false - not xramp */
5039 {
5040 snd_info *sp;
5041 int old_sync;
5042 Xen val;
5043
5044 sp = cp->sound;
5045 old_sync = sp->sync;
5046 sp->sync = 0;
5047 val = g_apply_env_1(Xen_list_4(C_double_to_Xen_real(0.0), rmp0, C_double_to_Xen_real(1.0), rmp1),
5048 samp, samps, C_double_to_Xen_real(1.0), cp, edpos, S_ramp_channel, false);
5049 sp->sync = old_sync;
5050 return(val);
5051 }
5052
5053 seg0 = Xen_real_to_C_double(rmp0);
5054 seg1 = Xen_real_to_C_double(rmp1);
5055
5056 if (ramp_channel(cp, seg0, (seg1 - seg0) / (double)(samps - 1),
5057 samp, samps, pos, NOT_IN_AS_ONE_EDIT))
5058 {
5059 if (cp->edits[pos]->peak_env)
5060 {
5061 mus_float_t data[4];
5062 data[0] = 0.0;
5063 data[1] = seg0;
5064 data[2] = 1.0;
5065 data[3] = seg1;
5066 if ((samp == 0) &&
5067 (samps >= cp->edits[pos]->samples))
5068 amp_env_env(cp, data, 2, pos, 1.0, 1.0, 0.0);
5069 else
5070 {
5071 mus_any *egen;
5072 egen = mus_make_env(data, 2, 1.0, 0.0, 1.0, 0.0, samps - 1, NULL);
5073 amp_env_env_selection_by(cp, egen, samp, samps, pos);
5074 mus_free(egen);
5075 }
5076 }
5077 update_graph(cp);
5078 }
5079 return(rmp0);
5080 }
5081
5082
5083 static Xen g_xramp_channel(Xen rmp0, Xen rmp1, Xen base, Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
5084 {
5085 #define H_xramp_channel "(" S_xramp_channel " rmp0 rmp1 base :optional (beg 0) (dur len) snd chn edpos): \
5086 scale samples in the given sound/channel between beg and beg + num by an exponential ramp going from rmp0 to rmp1 with curvature set by base."
5087
5088 chan_info *cp;
5089 mus_long_t samp, samps;
5090 int pos;
5091 mus_float_t ebase = 1.0;
5092
5093 Xen_check_type(Xen_is_number(rmp0), rmp0, 1, S_xramp_channel, "a number");
5094 Xen_check_type(Xen_is_number(rmp1), rmp1, 2, S_xramp_channel, "a number");
5095 Xen_check_type(Xen_is_number(base), base, 3, S_xramp_channel, "a number");
5096 Snd_assert_sample_type(S_xramp_channel, beg, 4);
5097 Snd_assert_sample_type(S_xramp_channel, num, 5);
5098 Snd_assert_sound(S_xramp_channel, snd, 6);
5099
5100 samp = beg_to_sample(beg, S_xramp_channel);
5101 cp = get_cp(snd, chn, S_xramp_channel);
5102 if (!cp) return(Xen_false);
5103 pos = to_c_edit_position(cp, edpos, S_xramp_channel, 8);
5104 samps = dur_to_samples(num, samp, cp, pos, 4, S_xramp_channel);
5105
5106 ebase = Xen_real_to_C_double(base);
5107 if (ebase < 0.0)
5108 Xen_out_of_range_error(S_xramp_channel, 3, base, "base < 0.0?");
5109 if (ebase > 1.0e10)
5110 Xen_out_of_range_error(S_xramp_channel, 3, base, "base too large");
5111
5112 if (unrampable(cp, samp, samps, pos, (ebase != 1.0)))
5113 {
5114 snd_info *sp;
5115 int old_sync;
5116 Xen val;
5117 sp = cp->sound;
5118 old_sync = sp->sync;
5119 sp->sync = 0;
5120 val = g_apply_env_1(Xen_list_4(C_double_to_Xen_real(0.0), rmp0, C_double_to_Xen_real(1.0), rmp1),
5121 samp, samps, base, cp, edpos, S_xramp_channel, false);
5122 sp->sync = old_sync;
5123 return(val);
5124 }
5125 else
5126 {
5127 double seg0;
5128
5129 seg0 = Xen_real_to_C_double(rmp0);
5130
5131 if (ebase == 0.0)
5132 scale_channel(cp, seg0, samp, samps, pos, NOT_IN_AS_ONE_EDIT);
5133 else
5134 {
5135 double seg1;
5136 seg1 = Xen_real_to_C_double(rmp1);
5137 if (ebase == 1.0)
5138 ramp_channel(cp, seg0, (seg1 - seg0) / (double)(samps - 1), samp, samps, pos, NOT_IN_AS_ONE_EDIT);
5139 else
5140 {
5141 mus_any *e;
5142 mus_float_t *data;
5143 mus_float_t *rates;
5144 data = (mus_float_t *)malloc(4 * sizeof(mus_float_t));
5145 data[0] = 0.0;
5146 data[1] = seg0;
5147 data[2] = 1.0;
5148 data[3] = seg1;
5149 e = mus_make_env(data, 2, 1.0, 0.0, ebase, 0.0, samps - 1, NULL);
5150
5151 rates = mus_env_rates(e);
5152 if (xramp_channel(cp, mus_env_initial_power(e), rates[0], mus_env_scaler(e), mus_env_offset(e), samp, samps, pos, NOT_IN_AS_ONE_EDIT, e, 0))
5153 {
5154 if (cp->edits[pos]->peak_env)
5155 {
5156 if ((samp == 0) &&
5157 (samps >= cp->edits[pos]->samples))
5158 amp_env_env(cp, data, 2, pos, ebase, mus_env_scaler(e), mus_env_offset(e));
5159 else
5160 {
5161 mus_any *egen;
5162 egen = mus_make_env(data, 2, 1.0, 0.0, ebase, 0.0, samps - 1, NULL);
5163 amp_env_env_selection_by(cp, egen, samp, samps, pos);
5164 mus_free(egen);
5165 }
5166 }
5167 }
5168 free(data);
5169 mus_free(e);
5170 update_graph(cp);
5171 }
5172 }
5173 }
5174 return(rmp0);
5175 }
5176
5177
5178 static Xen g_fft(Xen reals, Xen imag, Xen sign)
5179 {
5180 #define H_fft "(" S_fft " reals imags :optional (sign 1)): fft the data returning the result in reals. \
5181 If sign is -1, perform inverse fft. Incoming data is in " S_vct "s."
5182
5183 vct *v1 = NULL, *v2 = NULL;
5184 int n = 0, n2 = 0, isign = 1;
5185 bool need_free = false;
5186 mus_float_t *rl = NULL, *im = NULL;
5187
5188 Xen_check_type(Xen_is_integer_or_unbound(sign), sign, 3, S_fft, "an integer");
5189 Xen_check_type(mus_is_vct(reals), reals, 1, S_fft, S_vct);
5190 Xen_check_type(mus_is_vct(imag), imag, 2, S_fft, S_vct);
5191
5192 isign = (Xen_is_integer(sign)) ? Xen_integer_to_C_int(sign) : 1;
5193 v1 = Xen_to_vct(reals);
5194 v2 = Xen_to_vct(imag);
5195
5196 n = mus_vct_length(v1);
5197 if (mus_vct_length(v2) < n) n = mus_vct_length(v2);
5198 if (n == 0) return(Xen_integer_zero);
5199 if (is_power_of_2(n))
5200 {
5201 n2 = n;
5202 rl = mus_vct_data(v1);
5203 im = mus_vct_data(v2);
5204 }
5205 else
5206 {
5207 int ipow;
5208 ipow = (int)ceil(log(n + 1) / log(2.0)); /* ceil because we're assuming below that n2 >= n */
5209 n2 = snd_int_pow2(ipow);
5210 rl = (mus_float_t *)calloc(n2, sizeof(mus_float_t));
5211 im = (mus_float_t *)calloc(n2, sizeof(mus_float_t));
5212 need_free = true;
5213 mus_copy_floats(rl, mus_vct_data(v1), n);
5214 mus_copy_floats(im, mus_vct_data(v2), n);
5215 }
5216
5217 mus_fft(rl, im, n2, isign);
5218
5219 if (need_free)
5220 {
5221 mus_copy_floats(mus_vct_data(v1), rl, n);
5222 mus_copy_floats(mus_vct_data(v2), im, n);
5223 free(rl);
5224 free(im);
5225 }
5226 return(reals);
5227 }
5228
5229
5230 static Xen g_snd_spectrum(Xen data, Xen win, Xen len, Xen linear_or_dB, Xen beta, Xen in_place, Xen normalized)
5231 {
5232 #define H_snd_spectrum "(" S_snd_spectrum " data :optional (window " S_rectangular_window ") (len data-len) (linear " PROC_TRUE ") (beta 0.0) in-place (normalized " PROC_TRUE ")): \
5233 magnitude spectrum of data (a " S_vct "), in data if in-place, using fft-window win and fft length len."
5234
5235 bool linear = true, in_data = false, normed = true;
5236 int i, n, n2, wtype;
5237 mus_float_t maxa, lowest, b = 0.0;
5238 mus_float_t *rdat;
5239 vct *v;
5240
5241 Xen_check_type((mus_is_vct(data)), data, 1, S_snd_spectrum, "a " S_vct);
5242 Xen_check_type(Xen_is_integer_or_unbound(win), win, 2, S_snd_spectrum, "an integer");
5243 Xen_check_type(Xen_is_integer_or_unbound(len), len, 3, S_snd_spectrum, "an integer");
5244 Xen_check_type(Xen_is_boolean_or_unbound(linear_or_dB), linear_or_dB, 4, S_snd_spectrum, "a boolean");
5245 Xen_check_type(Xen_is_number_or_unbound(beta), beta, 5, S_snd_spectrum, "a number");
5246 Xen_check_type(Xen_is_boolean_or_unbound(in_place), in_place, 6, S_snd_spectrum, "a boolean");
5247 Xen_check_type(Xen_is_boolean_or_unbound(normalized), normalized, 7, S_snd_spectrum, "a boolean");
5248
5249 v = Xen_to_vct(data);
5250 n = (Xen_is_integer(len)) ? Xen_integer_to_C_int(len) : mus_vct_length(v);
5251 if (n > mus_vct_length(v)) n = mus_vct_length(v);
5252 if (n <= 0)
5253 Xen_out_of_range_error(S_snd_spectrum, 3, len, "length <= 0 or " S_vct " length == 0?");
5254
5255 if (Xen_is_boolean(linear_or_dB)) linear = Xen_boolean_to_C_bool(linear_or_dB);
5256 if (Xen_is_boolean(in_place)) in_data = Xen_boolean_to_C_bool(in_place);
5257 if (Xen_is_boolean(normalized)) normed = Xen_boolean_to_C_bool(normalized);
5258
5259 wtype = (Xen_is_integer(win)) ? Xen_integer_to_C_int(win) : (int)MUS_RECTANGULAR_WINDOW;
5260 if (!(mus_is_fft_window(wtype)))
5261 Xen_out_of_range_error(S_snd_spectrum, 2, win, "unknown fft window");
5262
5263 if (Xen_is_number(beta)) b = Xen_real_to_C_double(beta);
5264 if (b < 0.0) b = 0.0; else if (b > 1.0) b = 1.0;
5265
5266 if (!in_data)
5267 {
5268 mus_float_t *vdata;
5269 vdata = mus_vct_data(v);
5270 rdat = (mus_float_t *)malloc(n * sizeof(mus_float_t));
5271 if (n < mus_vct_length(v))
5272 for (i = 0; i < n; i++) rdat[i] = vdata[i];
5273 else mus_copy_floats(rdat, vdata, mus_vct_length(v));
5274 }
5275 else rdat = mus_vct_data(v);
5276
5277 if (wtype != (int)MUS_RECTANGULAR_WINDOW)
5278 {
5279 mus_float_t *window;
5280 window = (mus_float_t *)calloc(n, sizeof(mus_float_t));
5281 mus_make_fft_window_with_window((mus_fft_window_t)wtype, n, b * fft_beta_max((mus_fft_window_t)wtype), 0.0, window);
5282 for (i = 0; i < n; i++) rdat[i] *= window[i];
5283 free(window);
5284 }
5285
5286 n2 = n / 2;
5287 {
5288 int j;
5289 mus_float_t *idat;
5290 idat = (mus_float_t *)calloc(n, sizeof(mus_float_t));
5291 mus_fft(rdat, idat, n, 1);
5292 rdat[0] *= rdat[0];
5293 rdat[n2] *= rdat[n2];
5294 for (i = 1, j = n - 1; i < n2; i++, j--)
5295 {
5296 rdat[i] = rdat[i] * rdat[i] + idat[i] * idat[i];
5297 rdat[j] = rdat[i];
5298 }
5299 free(idat);
5300 }
5301
5302 lowest = 0.000001;
5303 maxa = 0.0;
5304 n = n / 2;
5305 for (i = 0; i < n; i++)
5306 {
5307 mus_float_t val;
5308 val = rdat[i];
5309 if (val < lowest)
5310 rdat[i] = 0.0;
5311 else
5312 {
5313 rdat[i] = sqrt(val);
5314 if (rdat[i] > maxa) maxa = rdat[i];
5315 }
5316 }
5317 if (maxa > 0.0)
5318 {
5319 if (normed)
5320 maxa = 1.0 / maxa;
5321 else maxa = 1.0;
5322 if (!linear) /* dB */
5323 {
5324 mus_float_t todb;
5325 todb = 20.0 / log(10.0);
5326 for (i = 0; i < n; i++)
5327 if (rdat[i] > 0.0)
5328 rdat[i] = todb * log(rdat[i] * maxa);
5329 else rdat[i] = -90.0; /* min_dB(ss)? or could channel case be less? */
5330 }
5331 else
5332 {
5333 if (normed)
5334 for (i = 0; i < n; i++)
5335 rdat[i] *= maxa;
5336 }
5337 }
5338 if (in_data)
5339 return(data);
5340 return(xen_make_vct(n, rdat)); /* xen_make_vct uses the data array directly (frees upon gc) */
5341 }
5342
5343
5344 static Xen g_convolve_with_1(Xen file, Xen new_amp, chan_info *cp, Xen edpos, const char *caller)
5345 {
5346 /* cp NULL -> selection (see above) */
5347 mus_float_t amp;
5348 static char *fname = NULL;
5349
5350 Xen_check_type(Xen_is_string(file), file, 1, caller, "a string");
5351
5352 if (Xen_is_number(new_amp))
5353 amp = Xen_real_to_C_double(new_amp);
5354 else
5355 {
5356 if (Xen_is_false(new_amp))
5357 amp = 0.0;
5358 else amp = 1.0;
5359 }
5360 if (fname) free(fname);
5361 fname = mus_expand_filename(Xen_string_to_C_string(file));
5362
5363 if (mus_file_probe(fname))
5364 {
5365 char *error;
5366 error = convolve_with_or_error(fname, amp, cp, edpos, 5);
5367 if (error)
5368 {
5369 Xen errstr;
5370 errstr = C_string_to_Xen_string(error);
5371 free(error);
5372 Xen_error(Xen_make_error_type("IO-error"),
5373 Xen_list_3(C_string_to_Xen_string("~A: IO error ~A"),
5374 C_string_to_Xen_string(caller),
5375 errstr));
5376 }
5377 }
5378 else return(snd_no_such_file_error(caller, file));
5379 return(file);
5380 }
5381
5382
5383 static Xen g_convolve_with(Xen file, Xen new_amp, Xen snd, Xen chn_n, Xen edpos)
5384 {
5385 #define H_convolve_with "(" S_convolve_with " file :optional (amp 1.0) snd chn edpos): \
5386 convolve file with snd's channel chn (or the currently sync'd channels); amp is the resultant peak amp"
5387
5388 chan_info *cp;
5389 Snd_assert_channel(S_convolve_with, snd, chn_n, 3);
5390 cp = get_cp(snd, chn_n, S_convolve_with);
5391 if (!cp) return(Xen_false);
5392 return(g_convolve_with_1(file, new_amp, cp, edpos, S_convolve_with));
5393 }
5394
5395
5396 static Xen g_convolve_selection_with(Xen file, Xen new_amp)
5397 {
5398 #define H_convolve_selection_with "(" S_convolve_selection_with " file :optional (amp 1.0)): \
5399 convolve the selection with file; amp is the resultant peak amp"
5400
5401 if (!(selection_is_active()))
5402 return(snd_no_active_selection_error(S_convolve_selection_with));
5403 return(g_convolve_with_1(file, new_amp, NULL, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), S_convolve_selection_with));
5404 }
5405
5406
5407 enum {SRC_ENV_NO_ERROR, SRC_ENV_HIT_ZERO, SRC_ENV_THROUGH_ZERO};
5408
5409 static mus_float_t check_src_envelope(int pts, mus_float_t *data, int *error)
5410 {
5411 /* can't go through zero here, and if negative need to return 1.0 */
5412 int i;
5413 mus_float_t res = 0.0;
5414 (*error) = SRC_ENV_NO_ERROR;
5415 for (i = 0; i < (2 * pts); i += 2)
5416 if (data[i + 1] == 0.0)
5417 {
5418 (*error) = SRC_ENV_HIT_ZERO;
5419 return(res);
5420 }
5421 else
5422 {
5423 if (data[i + 1] < 0.0)
5424 {
5425 if (res <= 0.0)
5426 res = -1.0;
5427 else
5428 {
5429 (*error) = SRC_ENV_THROUGH_ZERO;
5430 return(res);
5431 }
5432 }
5433 else
5434 {
5435 if (res >= 0)
5436 res = 1.0;
5437 else
5438 {
5439 (*error) = SRC_ENV_THROUGH_ZERO;
5440 return(res);
5441 }
5442 }
5443 }
5444 return(res);
5445 }
5446
5447
5448 static bool is_NaN(double x) {return(x != x);}
5449
5450 static Xen g_src_channel(Xen ratio_or_env, Xen beg_n, Xen dur_n, Xen snd, Xen chn_n, Xen edpos)
5451 {
5452 #define H_src_channel "(" S_src_channel " ratio-or-env :optional (beg 0) (dur len) snd chn edpos): \
5453 sampling-rate convert snd's channel chn by ratio, or following an envelope (a list or a CLM env generator)."
5454
5455 chan_info *cp;
5456 char *errmsg;
5457 snd_fd *sf;
5458 mus_long_t beg, dur;
5459 int pos;
5460 bool clm_err = false;
5461 mus_any *egen = NULL;
5462 bool need_free = false;
5463 mus_float_t ratio = 0.0; /* not 1.0 here! -- the zero is significant */
5464 env *e = NULL;
5465
5466 Xen_check_type((Xen_is_number(ratio_or_env)) ||
5467 (Xen_is_list(ratio_or_env)) ||
5468 ((mus_is_xen(ratio_or_env)) &&
5469 (mus_is_env(egen = Xen_to_mus_any(ratio_or_env)))),
5470 ratio_or_env, 1, S_src_channel, "a number, an envelope, or a CLM env generator");
5471 Snd_assert_sample_type(S_src_channel, beg_n, 2);
5472 Snd_assert_sample_type(S_src_channel, dur_n, 3);
5473 Snd_assert_channel(S_src_channel, snd, chn_n, 4);
5474
5475 cp = get_cp(snd, chn_n, S_src_channel);
5476 if (!cp) return(Xen_false);
5477 beg = beg_to_sample(beg_n, S_src_channel);
5478 pos = to_c_edit_position(cp, edpos, S_src_channel, 6);
5479 dur = dur_to_samples(dur_n, beg, cp, pos, 3, S_src_channel);
5480 if (dur == 0) return(Xen_false);
5481 if (beg > cp->edits[pos]->samples) return(Xen_false);
5482
5483 if (Xen_is_number(ratio_or_env))
5484 {
5485 ratio = Xen_real_to_C_double(ratio_or_env);
5486 if ((pos == cp->edit_ctr) &&
5487 ((ratio == 0.0) || (ratio == 1.0)))
5488 return(Xen_false);
5489 if ((is_NaN(ratio)) ||
5490 (fabs(ratio) < 1.0e-10)) /* dur > 0 here */
5491 Xen_out_of_range_error(S_src_channel, 1, ratio_or_env, "too small (resultant sound will be too large)");
5492 }
5493 else
5494 {
5495 int error = SRC_ENV_NO_ERROR;
5496 if (!egen)
5497 {
5498 e = get_env(ratio_or_env, S_src_channel);
5499 egen = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, dur - 1, NULL);
5500 need_free = true;
5501 }
5502 check_src_envelope(mus_env_breakpoints(egen), mus_data(egen), &error);
5503 if (error != SRC_ENV_NO_ERROR)
5504 {
5505 Xen data;
5506 if (e) free_env(e);
5507 data = mus_array_to_list(mus_data(egen), 0, mus_env_breakpoints(egen) * 2);
5508 if (need_free)
5509 mus_free(egen);
5510
5511 if (error == SRC_ENV_HIT_ZERO)
5512 Xen_out_of_range_error(S_src_channel, 1, data, "envelope hits 0.0");
5513 else Xen_out_of_range_error(S_src_channel, 1, data, "envelope passes through 0.0");
5514
5515 return(Xen_false); /* just for clarity... */
5516 }
5517 }
5518
5519 if (((egen) && (mus_phase(egen) >= 0.0)) ||
5520 ((!egen) && (ratio >= 0.0))) /* ratio == 0.0 if env in use because env is the srate (as change arg) */
5521 sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, (!egen) ? MAX_BUFFER_SIZE : FILE_BUFFER_SIZE);
5522 else sf = init_sample_read_any(beg + dur - 1, cp, READ_BACKWARD, pos);
5523
5524 errmsg = src_channel_with_error(cp, sf, beg, dur, ratio, egen, S_src_channel, OVER_SOUND, &clm_err);
5525 free_snd_fd(sf);
5526 if (need_free) mus_free(egen);
5527 if (e) free_env(e);
5528 if (errmsg)
5529 {
5530 Xen err;
5531 err = C_string_to_Xen_string(errmsg);
5532 free(errmsg);
5533 Xen_error(Xen_make_error_type((clm_err) ? "mus-error" : "IO-error"),
5534 Xen_list_2(C_string_to_Xen_string(S_src_channel ": ~A"),
5535 err));
5536 }
5537 return(ratio_or_env);
5538 }
5539
5540
5541 #if (defined(__sun) && defined(__SVR4))
5542 static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* there's no isinf in Solaris */
5543 #else
5544 #define is_inf(x) isinf(x)
5545 #endif
5546
5547 static Xen g_src_1(Xen ratio_or_env, Xen ebase, Xen snd, Xen chn_n, Xen edpos, const char *caller, bool over_selection)
5548 {
5549 chan_info *cp;
5550
5551 Snd_assert_channel(caller, snd, chn_n, 3);
5552 cp = get_cp(snd, chn_n, caller);
5553 if (!cp) return(Xen_false);
5554
5555 if (Xen_is_number(ratio_or_env))
5556 {
5557 mus_float_t ratio;
5558
5559 ratio = Xen_real_to_C_double(ratio_or_env);
5560 if ((is_NaN(ratio)) || (is_inf(ratio)))
5561 Xen_out_of_range_error(caller, 1, ratio_or_env, "src ratio must be a normal number");
5562
5563 if (ratio != 1.0)
5564 src_env_or_num(cp, NULL, ratio,
5565 true, caller,
5566 over_selection, NULL, edpos, 5);
5567 }
5568 else
5569 {
5570 int error = SRC_ENV_NO_ERROR;
5571 if (Xen_is_list(ratio_or_env))
5572 {
5573 env *e;
5574 mus_float_t e_ratio = 1.0;
5575
5576 /* env 'e' is a temp here, so we can clobber its base, etc */
5577 e = get_env(ratio_or_env, caller);
5578 if (Xen_is_number(ebase))
5579 e->base = Xen_real_to_C_double(ebase);
5580
5581 e_ratio = check_src_envelope(e->pts, e->data, &error);
5582 if (error != SRC_ENV_NO_ERROR)
5583 {
5584 Xen data;
5585 data = mus_array_to_list(e->data, 0, e->pts * 2);
5586 free_env(e);
5587 if (error == SRC_ENV_HIT_ZERO)
5588 Xen_out_of_range_error(caller, 1, data, "envelope hits 0.0");
5589 else Xen_out_of_range_error(caller, 1, data, "envelope passes through 0.0");
5590 }
5591 else
5592 {
5593 src_env_or_num(cp, e, e_ratio, false, caller, over_selection, NULL, edpos, 5);
5594 free_env(e);
5595 }
5596 }
5597 else
5598 {
5599 mus_any *egen;
5600 Xen_check_type(mus_is_xen(ratio_or_env), ratio_or_env, 1, caller, "a number, list, or env generator");
5601 egen = Xen_to_mus_any(ratio_or_env);
5602 Xen_check_type(mus_is_env(egen), ratio_or_env, 1, caller, "a number, list, or env generator");
5603
5604 check_src_envelope(mus_env_breakpoints(egen), mus_data(egen), &error);
5605 if (error != SRC_ENV_NO_ERROR)
5606 {
5607 Xen data;
5608 data = mus_array_to_list(mus_data(egen), 0, mus_env_breakpoints(egen) * 2);
5609 if (error == SRC_ENV_HIT_ZERO)
5610 Xen_out_of_range_error(S_src_channel, 1, data, "envelope hits 0.0");
5611 else Xen_out_of_range_error(S_src_channel, 1, data, "envelope passes through 0.0");
5612 }
5613 else
5614 src_env_or_num(cp, NULL,
5615 (mus_phase(egen) >= 0.0) ? 1.0 : -1.0, /* mus_phase of env apparently = current_value(!) */
5616 false, caller,
5617 over_selection, egen, edpos, 5);
5618 }
5619 }
5620 return(ratio_or_env);
5621 }
5622
5623
5624 static Xen g_src_sound(Xen ratio_or_env, Xen base, Xen snd, Xen chn_n, Xen edpos)
5625 {
5626 #define H_src_sound "(" S_src_sound " ratio-or-env :optional (base 1.0) snd chn edpos): \
5627 sampling-rate convert snd's channel chn by ratio, or following an envelope. A negative ratio reverses the sound"
5628
5629 return(g_src_1(ratio_or_env, base, snd, chn_n, edpos, S_src_sound, OVER_SOUND));
5630 }
5631
5632
5633 static Xen g_src_selection(Xen ratio_or_env, Xen base)
5634 {
5635 #define H_src_selection "(" S_src_selection " ratio-or-env :optional (base 1.0)): \
5636 sampling-rate convert the currently selected data by ratio (which can be an envelope)"
5637
5638 if (!(selection_is_active()))
5639 return(snd_no_active_selection_error(S_src_selection));
5640 return(g_src_1(ratio_or_env, base, Xen_false, Xen_false, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), S_src_selection, OVER_SELECTION));
5641 }
5642
5643
5644 static Xen g_filter_channel(Xen e, Xen order, Xen beg, Xen dur, Xen snd, Xen chn_n, Xen edpos, Xen truncate, Xen origin)
5645 {
5646 #define H_filter_channel "(" S_filter_channel " env :optional order beg dur snd chn edpos (truncate " PROC_TRUE ") origin): \
5647 applies an FIR filter to snd's channel chn. 'env' is the frequency response envelope, or a " S_vct " with the coefficients."
5648
5649 chan_info *cp;
5650 char *errstr = NULL;
5651 const char *caller = NULL;
5652 bool truncate_1 = true;
5653 int order_1 = 0, edpos_1 = AT_CURRENT_EDIT_POSITION;
5654 mus_long_t beg_1 = 0, dur_1 = 0;
5655 env *e_1 = NULL;
5656 mus_float_t *coeffs = NULL;
5657
5658 Xen_check_type(Xen_is_list(e) || mus_is_vct(e), e, 1, S_filter_channel, "an envelope or a " S_vct);
5659 Xen_check_type(Xen_is_integer_or_unbound(order), order, 2, S_filter_channel, "an integer");
5660 Xen_check_type(Xen_is_string_or_unbound(origin), origin, 9, S_filter_channel, "a string");
5661
5662 if (Xen_is_integer(order))
5663 {
5664 order_1 = Xen_integer_to_C_int(order);
5665 if (order_1 < 0)
5666 Xen_out_of_range_error(S_filter_channel, 2, order, "order should not be negative");
5667 }
5668 Snd_assert_channel(S_filter_channel, snd, chn_n, 5);
5669 cp = get_cp(snd, chn_n, S_filter_channel);
5670 if (!cp) return(Xen_false);
5671
5672 Xen_check_type(Xen_is_boolean_or_unbound(truncate), truncate, 8, S_filter_channel, "boolean");
5673 if (Xen_is_boolean(truncate)) truncate_1 = Xen_boolean_to_C_bool(truncate);
5674
5675 Snd_assert_sample_type(S_filter_channel, beg, 3);
5676 Snd_assert_sample_type(S_filter_channel, dur, 4);
5677
5678 beg_1 = beg_to_sample(beg, S_filter_channel);
5679 edpos_1 = to_c_edit_position(cp, edpos, S_filter_channel, 7);
5680 dur_1 = dur_to_samples(dur, beg_1, cp, edpos_1, 4, S_filter_channel);
5681
5682 if (Xen_is_list(e))
5683 {
5684 e_1 = get_env(e, S_filter_channel);
5685 if (!e_1) return(Xen_false);
5686 if (order_1 == 0) order_1 = e_1->pts * 4;
5687 }
5688 else
5689 {
5690 vct *v;
5691 int len;
5692 v = Xen_to_vct(e);
5693 len = mus_vct_length(v);
5694 if (len == 0)
5695 Xen_out_of_range_error(S_filter_channel, 1, e, "filter coeffs array is empty");
5696 coeffs = mus_vct_data(v);
5697 if (order_1 == 0) order_1 = len;
5698 }
5699 if (Xen_is_string(origin))
5700 caller = Xen_string_to_C_string(origin);
5701 else caller = S_filter_channel;
5702 /* if origin is NULL, direct_filter fills out the necessary parameters so that edit-list->function can re-call it,
5703 * so if we set it to S_filter_channel here, we need to ignore it in direct_filter.
5704 * Actually, the origin calculation in direct_filter should probably be moved here --
5705 * otherwise convolution_filter will not work with edit-list->function -- I haven't tested this.
5706 */
5707
5708 errstr = filter_channel(cp, order_1, e_1, beg_1, dur_1, edpos_1, caller, truncate_1, coeffs);
5709
5710 if (e_1) free_env(e_1);
5711 if (errstr)
5712 {
5713 Xen str;
5714 str = C_string_to_Xen_string(errstr);
5715 free(errstr);
5716 Xen_error(Xen_make_error_type("IO-error"),
5717 Xen_list_2(C_string_to_Xen_string(S_filter_channel ": IO error ~A"),
5718 str));
5719 }
5720 return(e);
5721 }
5722
5723
5724 static Xen g_filter_1(Xen e, Xen order, Xen snd, Xen chn_n, Xen edpos, const char *caller, const char *origin, bool over_selection, bool truncate)
5725 {
5726 chan_info *cp;
5727 Snd_assert_channel(caller, snd, chn_n, 3);
5728 cp = get_cp(snd, chn_n, caller);
5729 if (!cp) return(Xen_false);
5730 if (mus_is_xen(e))
5731 {
5732 char *error;
5733 bool clm_err = false;
5734 error = apply_filter_or_error(cp, 0, NULL, caller, origin, over_selection, NULL, Xen_to_mus_any(e), edpos, 5, truncate, &clm_err);
5735 if (error)
5736 {
5737 Xen errstr;
5738 errstr = C_string_to_Xen_string(error);
5739 free(error);
5740 Xen_error(Xen_make_error_type((clm_err) ? "mus-error" : "IO-error"),
5741 Xen_list_3(C_string_to_Xen_string("~A: ~A"),
5742 C_string_to_Xen_string(caller),
5743 errstr));
5744 }
5745 }
5746 else
5747 {
5748 int len = 0;
5749 Xen_check_type(Xen_is_integer_or_unbound(order), order, 2, caller, "an integer");
5750 if (Xen_is_integer(order))
5751 {
5752 len = Xen_integer_to_C_int(order);
5753 if (len <= 0)
5754 Xen_out_of_range_error(caller, 2, order, "order should be positive");
5755 }
5756 if (mus_is_vct(e)) /* the filter coefficients direct */
5757 {
5758 vct *v;
5759 char *new_origin = NULL, *estr = NULL;
5760 v = Xen_to_vct(e);
5761 if (len > mus_vct_length(v))
5762 Xen_out_of_range_error(caller, 2, order, "order > length coeffs");
5763 else
5764 {
5765 if (len == 0) len = mus_vct_length(v);
5766 }
5767 if ((!origin) && (mus_vct_length(v) < 16))
5768 {
5769 estr = mus_vct_to_readable_string(v);
5770 #if HAVE_FORTH
5771 new_origin = mus_format("%s %d%s %s",
5772 estr, len,
5773 (over_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE,
5774 caller);
5775 #else
5776 new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d%s",
5777 to_proc_name(caller), estr, len,
5778 (over_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
5779 #endif
5780 }
5781 else new_origin = mus_strdup(origin);
5782 apply_filter(cp, len, NULL, caller, new_origin, over_selection, mus_vct_data(v), NULL, edpos, 5, truncate);
5783 if (estr) free(estr);
5784 if (new_origin) free(new_origin);
5785 }
5786 else
5787 {
5788 env *ne = NULL;
5789 char *new_origin = NULL, *estr = NULL;
5790 Xen_check_type(Xen_is_list(e), e, 1, caller, "a list, " S_vct ", or env generator");
5791 ne = get_env(e, caller); /* arg here must be a list */
5792 if (!origin)
5793 {
5794 estr = env_to_string(ne);
5795 #if HAVE_FORTH
5796 new_origin = mus_format("%s %d%s %s",
5797 estr, len,
5798 (over_selection) ? "" : " 0 " PROC_FALSE,
5799 caller);
5800 #else
5801 new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d%s",
5802 to_proc_name(caller), estr, len, (over_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
5803 #endif
5804 }
5805 else new_origin = mus_strdup(origin);
5806 if (len == 0) len = ne->pts * 4;
5807 apply_filter(cp, len, ne, caller, new_origin, over_selection, NULL, NULL, edpos, 5, truncate);
5808 if (ne) free_env(ne);
5809 if (estr) free(estr);
5810 if (new_origin) free(new_origin);
5811 }
5812 }
5813 return(Xen_true);
5814 }
5815
5816
5817 static Xen g_filter_sound(Xen e, Xen order, Xen snd, Xen chn_n, Xen edpos, Xen origin)
5818 {
5819 #define H_filter_sound "(" S_filter_sound " filter :optional order snd chn edpos origin): \
5820 applies FIR filter to snd's channel chn. 'filter' is either the frequency response envelope, a CLM filter, or a " S_vct " with the actual coefficients"
5821
5822 Xen_check_type(Xen_is_string_or_unbound(origin), origin, 6, S_filter_sound, "a string");
5823 return(g_filter_1(e, order, snd, chn_n, edpos,
5824 S_filter_sound, (Xen_is_string(origin)) ? Xen_string_to_C_string(origin) : NULL,
5825 OVER_SOUND, false));
5826 }
5827
5828
5829 static Xen g_filter_selection(Xen e, Xen order, Xen truncate)
5830 {
5831 #define H_filter_selection "(" S_filter_selection " filter :optional order (truncate " PROC_TRUE ")): apply filter to selection. If truncate, \
5832 cut off filter output at end of selection, else mix"
5833
5834 Xen_check_type(Xen_is_boolean_or_unbound(truncate), truncate, 3, S_filter_selection, "boolean");
5835 if (!(selection_is_active()))
5836 return(snd_no_active_selection_error(S_filter_selection));
5837 return(g_filter_1(e, order, Xen_false, Xen_false,
5838 C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION),
5839 S_filter_selection, NULL,
5840 OVER_SELECTION, Xen_boolean_to_C_bool(truncate)));
5841 }
5842
5843
5844 static Xen g_sinc_width(void) {return(C_int_to_Xen_integer(sinc_width(ss)));}
5845
5846 static Xen g_set_sinc_width(Xen val)
5847 {
5848 #define H_sinc_width "(" S_sinc_width "): sampling rate conversion sinc width (10). \
5849 The higher this number, the better the src low-pass filter, but the slower \
5850 src runs. If you use too low a setting, you can sometimes hear high \
5851 frequency whistles leaking through."
5852
5853 int len;
5854 Xen_check_type(Xen_is_integer(val), val, 1, S_set S_sinc_width, "an integer");
5855 len = Xen_integer_to_C_int(val);
5856 if ((len >= 0) && (len <= MUS_MAX_CLM_SINC_WIDTH))
5857 set_sinc_width(len);
5858 return(C_int_to_Xen_integer(sinc_width(ss)));
5859 }
5860
5861
5862 #ifndef _MSC_VER
5863 #include <sys/time.h>
5864 #endif
5865
5866 #if 0
5867 static int primes[129] = {1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83,
5868 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181,
5869 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
5870 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397,
5871 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503,
5872 509, 521, 523, 541, 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619,
5873 631, 641, 643, 647, 653, 659, 661, 673, 677, 683, 691, 701, 709, 719};
5874 #else
5875 static int primes[2049] =
5876 {1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83,
5877 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181,
5878 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
5879 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397,
5880 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503,
5881 509, 521, 523, 541, 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619,
5882 631, 641, 643, 647, 653, 659, 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761,
5883 769, 773, 787, 797, 809, 811, 821, 823, 827, 829, 839, 853, 857, 859, 863, 877, 881, 883,
5884 887, 907, 911, 919, 929, 937, 941, 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, 1019,
5885 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129,
5886 1151, 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, 1229, 1231, 1237, 1249, 1259, 1277, 1279,
5887 1283, 1289, 1291, 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 1381, 1399, 1409, 1423, 1427,
5888 1429, 1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, 1523, 1531, 1543,
5889 1549, 1553, 1559, 1567, 1571, 1579, 1583, 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, 1663,
5890 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801,
5891 1811, 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, 1901, 1907, 1913, 1931, 1933, 1949, 1951,
5892 1973, 1979, 1987, 1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 2063, 2069, 2081, 2083, 2087,
5893 2089, 2099, 2111, 2113, 2129, 2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, 2221, 2237, 2239,
5894 2243, 2251, 2267, 2269, 2273, 2281, 2287, 2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, 2371,
5895 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423, 2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521,
5896 2531, 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617, 2621, 2633, 2647, 2657, 2659, 2663, 2671,
5897 2677, 2683, 2687, 2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, 2749, 2753, 2767, 2777, 2789,
5898 2791, 2797, 2801, 2803, 2819, 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, 2909, 2917, 2927,
5899 2939, 2953, 2957, 2963, 2969, 2971, 2999, 3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, 3083,
5900 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, 3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253,
5901 3257, 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, 3343, 3347, 3359, 3361, 3371, 3373, 3389,
5902 3391, 3407, 3413, 3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, 3517, 3527, 3529, 3533, 3539,
5903 3541, 3547, 3557, 3559, 3571, 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, 3659, 3671, 3673,
5904 3677, 3691, 3697, 3701, 3709, 3719, 3727, 3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, 3823,
5905 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, 3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967,
5906 3989, 4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, 4073, 4079, 4091, 4093, 4099, 4111, 4127,
5907 4129, 4133, 4139, 4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, 4241, 4243, 4253, 4259, 4261,
5908 4271, 4273, 4283, 4289, 4297, 4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409, 4421, 4423, 4441,
5909 4447, 4451, 4457, 4463, 4481, 4483, 4493, 4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, 4591,
5910 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657, 4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733,
5911 4751, 4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, 4861, 4871, 4877, 4889, 4903, 4909, 4919,
5912 4931, 4933, 4937, 4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003, 5009, 5011, 5021, 5023, 5039,
5913 5051, 5059, 5077, 5081, 5087, 5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, 5189, 5197, 5209,
5914 5227, 5231, 5233, 5237, 5261, 5273, 5279, 5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, 5393,
5915 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443, 5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519,
5916 5521, 5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639, 5641, 5647, 5651, 5653, 5657, 5659, 5669,
5917 5683, 5689, 5693, 5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, 5801, 5807, 5813, 5821, 5827,
5918 5839, 5843, 5849, 5851, 5857, 5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939, 5953, 5981, 5987,
5919 6007, 6011, 6029, 6037, 6043, 6047, 6053, 6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133, 6143,
5920 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221, 6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299,
5921 6301, 6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367, 6373, 6379, 6389, 6397, 6421, 6427, 6449,
5922 6451, 6469, 6473, 6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571, 6577, 6581, 6599, 6607, 6619,
5923 6637, 6653, 6659, 6661, 6673, 6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, 6763, 6779, 6781,
5924 6791, 6793, 6803, 6823, 6827, 6829, 6833, 6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917, 6947,
5925 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997, 7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079,
5926 7103, 7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207, 7211, 7213, 7219, 7229, 7237, 7243, 7247,
5927 7253, 7283, 7297, 7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411, 7417, 7433, 7451, 7457, 7459,
5928 7477, 7481, 7487, 7489, 7499, 7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561, 7573, 7577, 7583,
5929 7589, 7591, 7603, 7607, 7621, 7639, 7643, 7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, 7727,
5930 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829, 7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907,
5931 7919, 7927, 7933, 7937, 7949, 7951, 7963, 7993, 8009, 8011, 8017, 8039, 8053, 8059, 8069, 8081, 8087, 8089,
5932 8093, 8101, 8111, 8117, 8123, 8147, 8161, 8167, 8171, 8179, 8191, 8209, 8219, 8221, 8231, 8233, 8237, 8243,
5933 8263, 8269, 8273, 8287, 8291, 8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369, 8377, 8387, 8389, 8419, 8423,
5934 8429, 8431, 8443, 8447, 8461, 8467, 8501, 8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597, 8599,
5935 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, 8681, 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737,
5936 8741, 8747, 8753, 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831, 8837, 8839, 8849, 8861, 8863, 8867, 8887,
5937 8893, 8923, 8929, 8933, 8941, 8951, 8963, 8969, 8971, 8999, 9001, 9007, 9011, 9013, 9029, 9041, 9043, 9049,
5938 9059, 9067, 9091, 9103, 9109, 9127, 9133, 9137, 9151, 9157, 9161, 9173, 9181, 9187, 9199, 9203, 9209, 9221,
5939 9227, 9239, 9241, 9257, 9277, 9281, 9283, 9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349, 9371, 9377, 9391,
5940 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, 9439, 9461, 9463, 9467, 9473, 9479, 9491, 9497, 9511, 9521,
5941 9533, 9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, 9643, 9649, 9661, 9677, 9679, 9689, 9697,
5942 9719, 9721, 9733, 9739, 9743, 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, 9817, 9829, 9833, 9839, 9851,
5943 9857, 9859, 9871, 9883, 9887, 9901, 9907, 9923, 9929, 9931, 9941, 9949, 9967, 9973, 10007, 10009, 10037, 10039,
5944 10061, 10067, 10069, 10079, 10091, 10093, 10099, 10103, 10111, 10133, 10139, 10141, 10151, 10159, 10163, 10169, 10177, 10181,
5945 10193, 10211, 10223, 10243, 10247, 10253, 10259, 10267, 10271, 10273, 10289, 10301, 10303, 10313, 10321, 10331, 10333, 10337,
5946 10343, 10357, 10369, 10391, 10399, 10427, 10429, 10433, 10453, 10457, 10459, 10463, 10477, 10487, 10499, 10501, 10513, 10529,
5947 10531, 10559, 10567, 10589, 10597, 10601, 10607, 10613, 10627, 10631, 10639, 10651, 10657, 10663, 10667, 10687, 10691, 10709,
5948 10711, 10723, 10729, 10733, 10739, 10753, 10771, 10781, 10789, 10799, 10831, 10837, 10847, 10853, 10859, 10861, 10867, 10883,
5949 10889, 10891, 10903, 10909, 10937, 10939, 10949, 10957, 10973, 10979, 10987, 10993, 11003, 11027, 11047, 11057, 11059, 11069,
5950 11071, 11083, 11087, 11093, 11113, 11117, 11119, 11131, 11149, 11159, 11161, 11171, 11173, 11177, 11197, 11213, 11239, 11243,
5951 11251, 11257, 11261, 11273, 11279, 11287, 11299, 11311, 11317, 11321, 11329, 11351, 11353, 11369, 11383, 11393, 11399, 11411,
5952 11423, 11437, 11443, 11447, 11467, 11471, 11483, 11489, 11491, 11497, 11503, 11519, 11527, 11549, 11551, 11579, 11587, 11593,
5953 11597, 11617, 11621, 11633, 11657, 11677, 11681, 11689, 11699, 11701, 11717, 11719, 11731, 11743, 11777, 11779, 11783, 11789,
5954 11801, 11807, 11813, 11821, 11827, 11831, 11833, 11839, 11863, 11867, 11887, 11897, 11903, 11909, 11923, 11927, 11933, 11939,
5955 11941, 11953, 11959, 11969, 11971, 11981, 11987, 12007, 12011, 12037, 12041, 12043, 12049, 12071, 12073, 12097, 12101, 12107,
5956 12109, 12113, 12119, 12143, 12149, 12157, 12161, 12163, 12197, 12203, 12211, 12227, 12239, 12241, 12251, 12253, 12263, 12269,
5957 12277, 12281, 12289, 12301, 12323, 12329, 12343, 12347, 12373, 12377, 12379, 12391, 12401, 12409, 12413, 12421, 12433, 12437,
5958 12451, 12457, 12473, 12479, 12487, 12491, 12497, 12503, 12511, 12517, 12527, 12539, 12541, 12547, 12553, 12569, 12577, 12583,
5959 12589, 12601, 12611, 12613, 12619, 12637, 12641, 12647, 12653, 12659, 12671, 12689, 12697, 12703, 12713, 12721, 12739, 12743,
5960 12757, 12763, 12781, 12791, 12799, 12809, 12821, 12823, 12829, 12841, 12853, 12889, 12893, 12899, 12907, 12911, 12917, 12919,
5961 12923, 12941, 12953, 12959, 12967, 12973, 12979, 12983, 13001, 13003, 13007, 13009, 13033, 13037, 13043, 13049, 13063, 13093,
5962 13099, 13103, 13109, 13121, 13127, 13147, 13151, 13159, 13163, 13171, 13177, 13183, 13187, 13217, 13219, 13229, 13241, 13249,
5963 13259, 13267, 13291, 13297, 13309, 13313, 13327, 13331, 13337, 13339, 13367, 13381, 13397, 13399, 13411, 13417, 13421, 13441,
5964 13451, 13457, 13463, 13469, 13477, 13487, 13499, 13513, 13523, 13537, 13553, 13567, 13577, 13591, 13597, 13613, 13619, 13627,
5965 13633, 13649, 13669, 13679, 13681, 13687, 13691, 13693, 13697, 13709, 13711, 13721, 13723, 13729, 13751, 13757, 13759, 13763,
5966 13781, 13789, 13799, 13807, 13829, 13831, 13841, 13859, 13873, 13877, 13879, 13883, 13901, 13903, 13907, 13913, 13921, 13931,
5967 13933, 13963, 13967, 13997, 13999, 14009, 14011, 14029, 14033, 14051, 14057, 14071, 14081, 14083, 14087, 14107, 14143, 14149,
5968 14153, 14159, 14173, 14177, 14197, 14207, 14221, 14243, 14249, 14251, 14281, 14293, 14303, 14321, 14323, 14327, 14341, 14347,
5969 14369, 14387, 14389, 14401, 14407, 14411, 14419, 14423, 14431, 14437, 14447, 14449, 14461, 14479, 14489, 14503, 14519, 14533,
5970 14537, 14543, 14549, 14551, 14557, 14561, 14563, 14591, 14593, 14621, 14627, 14629, 14633, 14639, 14653, 14657, 14669, 14683,
5971 14699, 14713, 14717, 14723, 14731, 14737, 14741, 14747, 14753, 14759, 14767, 14771, 14779, 14783, 14797, 14813, 14821, 14827,
5972 14831, 14843, 14851, 14867, 14869, 14879, 14887, 14891, 14897, 14923, 14929, 14939, 14947, 14951, 14957, 14969, 14983, 15013,
5973 15017, 15031, 15053, 15061, 15073, 15077, 15083, 15091, 15101, 15107, 15121, 15131, 15137, 15139, 15149, 15161, 15173, 15187,
5974 15193, 15199, 15217, 15227, 15233, 15241, 15259, 15263, 15269, 15271, 15277, 15287, 15289, 15299, 15307, 15313, 15319, 15329,
5975 15331, 15349, 15359, 15361, 15373, 15377, 15383, 15391, 15401, 15413, 15427, 15439, 15443, 15451, 15461, 15467, 15473, 15493,
5976 15497, 15511, 15527, 15541, 15551, 15559, 15569, 15581, 15583, 15601, 15607, 15619, 15629, 15641, 15643, 15647, 15649, 15661,
5977 15667, 15671, 15679, 15683, 15727, 15731, 15733, 15737, 15739, 15749, 15761, 15767, 15773, 15787, 15791, 15797, 15803, 15809,
5978 15817, 15823, 15859, 15877, 15881, 15887, 15889, 15901, 15907, 15913, 15919, 15923, 15937, 15959, 15971, 15973, 15991, 16001,
5979 16007, 16033, 16057, 16061, 16063, 16067, 16069, 16073, 16087, 16091, 16097, 16103, 16111, 16127, 16139, 16141, 16183, 16187,
5980 16189, 16193, 16217, 16223, 16229, 16231, 16249, 16253, 16267, 16273, 16301, 16319, 16333, 16339, 16349, 16361, 16363, 16369,
5981 16381, 16411, 16417, 16421, 16427, 16433, 16447, 16451, 16453, 16477, 16481, 16487, 16493, 16519, 16529, 16547, 16553, 16561,
5982 16567, 16573, 16603, 16607, 16619, 16631, 16633, 16649, 16651, 16657, 16661, 16673, 16691, 16693, 16699, 16703, 16729, 16741,
5983 16747, 16759, 16763, 16787, 16811, 16823, 16829, 16831, 16843, 16871, 16879, 16883, 16889, 16901, 16903, 16921, 16927, 16931,
5984 16937, 16943, 16963, 16979, 16981, 16987, 16993, 17011, 17021, 17027, 17029, 17033, 17041, 17047, 17053, 17077, 17093, 17099,
5985 17107, 17117, 17123, 17137, 17159, 17167, 17183, 17189, 17191, 17203, 17207, 17209, 17231, 17239, 17257, 17291, 17293, 17299,
5986 17317, 17321, 17327, 17333, 17341, 17351, 17359, 17377, 17383, 17387, 17389, 17393, 17401, 17417, 17419, 17431, 17443, 17449,
5987 17467, 17471, 17477, 17483, 17489, 17491, 17497, 17509, 17519, 17539, 17551, 17569, 17573, 17579, 17581, 17597, 17599, 17609,
5988 17623, 17627, 17657, 17659, 17669, 17681, 17683, 17707, 17713, 17729, 17737, 17747, 17749, 17761, 17783, 17789, 17791, 17807,
5989 17827, 17837, 17839, 17851, 17863};
5990 #endif
5991
5992 static mus_float_t all_mins[128] = {1.0000, 1.7600, 1.9797, 2.0390, 2.3435, 2.5493, 2.6394, 2.7946, 2.9617, 3.1023, 3.2180, 3.3887, 3.5241, 3.6122, 3.7680, 3.8738, 3.9802, 4.1397, 4.2182, 4.2880, 4.4425, 4.5399, 4.6037, 4.7280, 4.8529, 4.9819, 5.0640, 5.1567, 5.2413, 5.3613, 5.4531, 5.5256, 5.6085, 5.7151, 5.7615, 5.8717, 5.9181, 6.0558, 6.1236, 6.2239, 6.2785, 6.3741, 6.4746, 6.5441, 6.6127, 6.6910, 6.7566, 6.8041, 6.8716, 6.9660, 6.9718, 7.1018, 7.1684, 7.2456, 7.3000, 7.3494, 7.4415, 7.4714, 7.4694, 7.5887, 7.7185, 7.7918, 7.7927, 7.8504, 7.9354, 8.0115, 8.0440, 8.1314, 8.1403, 8.1770, 8.2913, 8.3678, 8.3715, 8.4685, 8.5124, 8.5666, 8.6559, 8.7132, 8.7674, 8.8316, 8.7973, 8.8502, 8.9350, 9.0232, 9.0499, 9.1449, 9.1879, 9.2434, 9.3155, 9.3693, 9.4066, 9.4199, 9.4126, 9.5437, 9.5949, 9.6988, 9.7336, 9.7670, 9.8274, 9.8281, 9.9219, 9.9997, 9.9365, 10.0175, 10.0636, 10.1795, 10.2507, 10.3130, 10.3161, 10.3845, 10.4435, 10.4596, 10.5332, 10.5179, 10.6217, 10.6669, 10.7403, 10.7900, 10.8359, 10.8779, 10.9249, 10.9498, 11.0161, 11.0603, 11.1055, 11.1455, 11.1761, 11.2104};
5993
5994 static mus_float_t odd_mins[128] = {1.0000, 1.5390, 1.7387, 2.0452, 2.3073, 2.5227, 2.6183, 2.7907, 2.8862, 3.0534, 3.1766, 3.3619, 3.4745, 3.5985, 3.7384, 3.8570, 3.9264, 4.0695, 4.1719, 4.3004, 4.3988, 4.5190, 4.6344, 4.7830, 4.8336, 4.9967, 5.0854, 5.0889, 5.2573, 5.3526, 5.4189, 5.5543, 5.5967, 5.7260, 5.8007, 5.9555, 5.9587, 6.0708, 6.1678, 6.2652, 6.3216, 6.4032, 6.4742, 6.5992, 6.6249, 6.7092, 6.7852, 6.8280, 6.9858, 6.9471, 7.0877, 7.0801, 7.2526, 7.3281, 7.3642, 7.4191, 7.4889, 7.5859, 7.6178, 7.6996, 7.7755, 7.8170, 7.9041, 7.9574, 8.0409, 8.0952, 8.1280, 8.2044, 8.2749, 8.3285, 8.3835, 8.3664, 8.5147, 8.4879, 8.6207, 8.6513, 8.7070, 8.7153, 8.8646, 8.8701, 8.9263, 8.8955, 9.0607, 9.1335, 9.1729, 9.2133, 9.3170, 9.3240, 9.3316, 9.4217, 9.4566, 9.5527, 9.6288, 9.6539, 9.7169, 9.7594, 9.8323, 9.8526, 9.9278, 9.9678, 9.9646, 10.0458, 10.1025, 10.1685, 10.1158, 10.1983, 10.2960, 10.3255, 10.4140, 10.4081, 10.4171, 10.5820, 10.5864, 10.6208, 10.6743, 10.7333, 10.7833, 10.8122, 10.8155, 10.9086, 10.9649, 11.0108, 11.0879, 11.1203, 11.1221, 11.2172, 11.2677, 11.2612};
5995
5996 static mus_float_t prime_mins[128] = {1.0000, 1.7600, 1.9798, 2.1921, 2.4768, 2.8054, 3.0618, 3.2628, 3.3822, 3.6019, 3.7784, 3.9359, 4.1545, 4.3244, 4.4659, 4.6003, 4.7186, 4.8551, 4.9988, 5.1826, 5.3236, 5.4336, 5.5623, 5.6422, 5.8108, 6.0560, 6.1340, 6.1909, 6.3650, 6.4518, 6.6155, 6.7719, 6.8464, 6.9912, 7.1636, 7.1869, 7.2910, 7.3959, 7.4521, 7.5274, 7.7192, 7.8634, 7.9364, 8.0652, 8.1549, 8.2605, 8.2472, 8.4681, 8.5828, 8.6759, 8.6516, 8.8175, 8.9482, 8.9955, 9.1430, 9.1118, 9.2168, 9.4251, 9.4178, 9.5291, 9.5971, 9.6970, 9.6932, 9.9049, 10.0313, 10.0406, 10.2660, 10.2616, 10.3583, 10.3621, 10.4075, 10.4970, 10.4247, 10.6460, 10.7289, 10.7732, 10.7871, 10.9786, 10.9996, 11.1246, 11.3109, 11.3865, 11.4001, 11.4872, 11.5705, 11.4640, 11.5865, 11.7792, 11.7172, 11.9121, 12.0055, 11.8779, 11.9314, 12.0399, 12.0860, 12.1999, 12.2938, 12.3727, 12.5774, 12.5080, 12.3999, 12.5091, 12.6727, 12.8169, 12.9165, 12.7944, 12.9882, 12.9496, 13.0181, 13.0735, 13.3043, 13.4320, 13.3789, 13.4760, 13.4814, 13.6086, 13.6802, 13.8100, 13.7456, 13.7572, 13.8806, 13.9065, 13.9862, 14.1155, 14.1096, 14.1161, 14.0378, 14.2402};
5997
5998 static mus_float_t even_mins[128] = {1.0000, 1.7602, 2.0215, 2.4306, 2.6048, 2.8370, 3.0470, 3.1975, 3.4540, 3.5587, 3.6561, 3.7869, 3.9726, 4.0967, 4.1921, 4.3250, 4.4630, 4.5694, 4.7415, 4.8395, 4.9197, 5.0552, 5.1479, 5.2532, 5.4032, 5.4523, 5.6204, 5.7317, 5.7663, 5.9070, 5.9878, 6.0611, 6.1619, 6.2228, 6.3617, 6.4316, 6.5302, 6.5360, 6.6802, 6.7476, 6.8804, 6.9400, 7.0517, 7.0391, 7.1643, 7.2740, 7.2898, 7.3923, 7.5290, 7.5471, 7.5686, 7.7050, 7.7478, 7.8429, 7.8878, 7.9747, 7.9655, 8.1007, 8.1919, 8.2950, 8.2268, 8.3868, 8.4105, 8.4885, 8.5672, 8.6324, 8.6805, 8.7377, 8.8613, 8.7383, 8.8715, 8.9661, 8.9989, 9.0897, 9.1223, 9.2670, 9.2587, 9.3283, 9.3569, 9.4514, 9.4842, 9.4971, 9.5274, 9.6148, 9.6764, 9.7580, 9.8338, 9.7183, 9.9973, 10.0054, 10.0428, 10.0938, 10.0656, 10.1228, 10.2691, 10.2410, 10.3316, 10.4691, 10.3878, 10.4419, 10.5743, 10.5388, 10.6377, 10.6556, 10.7237, 10.8126, 10.8718, 10.9019, 10.9585, 11.0599, 10.9622, 11.1279, 11.0422, 11.0983, 11.1109, 11.2778, 11.2957, 11.4305, 11.4631, 11.3135, 11.4986, 11.5297, 11.5885, 11.6136, 11.6968, 11.7032, 11.7900, 11.8302};
5999
6000 static mus_float_t min_8[4] = {15.9975, 16.2419, 16.8959, 23.9548};
6001 static mus_float_t min_9[4] = {23.1900, 23.5159, 24.5104, 38.6029};
6002 static mus_float_t min_10[4] = {33.0298, 33.7318, 34.4867, 65.3493};
6003 static mus_float_t min_11[4] = {48.9126, 48.2271, 50.8873, 95.9043};
6004
6005 #define USE_CLM_RANDOM (!HAVE_SCHEME)
6006
6007 static mus_float_t local_random(mus_float_t val)
6008 {
6009 #if USE_CLM_RANDOM
6010 return(mus_random(val));
6011 #else
6012 return(val * (1.0 - (s7_random(s7, NULL) * 2.0)));
6013 #endif
6014 }
6015
6016
6017 static mus_float_t local_frandom(mus_float_t val)
6018 {
6019 #if USE_CLM_RANDOM
6020 return(mus_frandom(val));
6021 #else
6022 return(val * s7_random(s7, NULL));
6023 #endif
6024 }
6025
6026
6027 typedef struct {
6028 mus_float_t pk;
6029 mus_float_t *phases;
6030 } pk_data;
6031
6032
6033 /* -------------------------------------------------------------------------------- */
6034
6035 #define ALL 0
6036 #define ODD 1
6037 #define EVEN 2
6038 #define PRIME 3
6039
6040 #define FFT_MULT 160
6041 /* if 64, errors or .005 are common
6042 * if 128, which works in 99% of the cases, errors can be as much as .002
6043 */
6044
6045 #define S_fpsap "fpsap"
6046
6047 static mus_float_t saved_min(int ch, int nn)
6048 {
6049 if (nn <= 128)
6050 {
6051 switch (ch)
6052 {
6053 case ALL: return(all_mins[nn - 1]);
6054 case ODD: return(odd_mins[nn - 1]);
6055 case EVEN: return(even_mins[nn - 1]);
6056 case PRIME: return(prime_mins[nn - 1]);
6057 }
6058 }
6059 if (nn == 256) return(min_8[ch]);
6060 if (nn == 512) return(min_9[ch]);
6061 if (nn == 1024) return(min_10[ch]);
6062 if (nn == 2048) return(min_11[ch]);
6063 return((mus_float_t)nn);
6064 }
6065
6066 static mus_float_t set_saved_min(int ch, int nn, mus_float_t new_val)
6067 {
6068 if (nn <= 128)
6069 {
6070 switch (ch)
6071 {
6072 case ALL: all_mins[nn - 1] = new_val; break;
6073 case ODD: odd_mins[nn - 1] = new_val; break;
6074 case EVEN: even_mins[nn - 1] = new_val; break;
6075 case PRIME: prime_mins[nn - 1] = new_val; break;
6076 }
6077 }
6078 if (nn == 256) min_8[ch] = new_val;
6079 if (nn == 512) min_9[ch] = new_val;
6080 if (nn == 1024) min_10[ch] = new_val;
6081 if (nn == 2048) min_11[ch] = new_val;
6082 return((mus_float_t)nn);
6083 }
6084
6085
6086 static mus_float_t get_peak(int choice, int fft_size, int n, mus_float_t *phases, mus_float_t *rl, mus_float_t *im)
6087 {
6088 int i, m;
6089 mus_float_t pi2, mx_sin;
6090
6091 pi2 = M_PI / 2.0;
6092 mus_clear_floats(rl, fft_size);
6093 mus_clear_floats(im, fft_size);
6094
6095 for (m = 0; m < n; m++)
6096 {
6097 int bin;
6098 mus_float_t phi;
6099 phi = (M_PI * phases[m]) + pi2;
6100 if (choice == ALL)
6101 bin = m + 1;
6102 else
6103 {
6104 if (choice == ODD)
6105 bin = (m * 2) + 1;
6106 else
6107 {
6108 if (choice == EVEN)
6109 {
6110 bin = m * 2;
6111 if (bin == 0) bin = 1;
6112 }
6113 else bin = primes[m];
6114 }
6115 }
6116 rl[bin] = cos(phi);
6117 im[bin] = sin(phi);
6118 }
6119
6120 mus_fft(rl, im, fft_size, -1);
6121 /* real part is sine reconstruction, imaginary part is cosine, we were originally interested in both */
6122 /* we could also add and subtract the 2 to get 2 more cases "for free", amp sqrt(2), phase asin(cos(0)/sqrt(2)) */
6123 /* and repeat this with a shift (rotation from i) for 2n other cases */
6124 /* resultant amp is between 0 and 2 (cosine) */
6125
6126 mus_abs_floats(rl, fft_size);
6127 mx_sin = rl[0];
6128 for (i = 1; i < fft_size; i++)
6129 mx_sin = (rl[i] > mx_sin) ? rl[i] : mx_sin;
6130
6131 return(mx_sin);
6132 }
6133
6134
6135 static Xen g_fpsap(Xen x_choice, Xen x_n, Xen start_phases, Xen x_size, Xen x_increment)
6136 {
6137 #define H_fpsap "(" S_fpsap " choice n phases (size 6000) (increment 0.06)) searches \
6138 for a peak-amp minimum using a simulated annealing form of the genetic algorithm. choice: 0=all, 1=odd, 2=even, 3=prime."
6139
6140 #define INCR_DOWN 0.92
6141 #define INCR_MAX 1.0
6142 #define INCR_MIN 0.00005
6143 #define RETRIES 10
6144 #define RETRY_MULT 2
6145 #define INIT_TRIES 5000
6146
6147 int choice, n, size, counts = 0;
6148 mus_float_t increment = INCR_MAX, orig_incr, local_best = 1000.0, incr_mult = INCR_DOWN, overall_min;
6149 mus_float_t *min_phases = NULL, *temp_phases = NULL, *diff_phases = NULL, *initial_phases = NULL;
6150 const char *choice_name[4] = {"all", "odd", "even", "prime"};
6151 pk_data **choices = NULL, **free_choices = NULL;
6152 mus_float_t *rl, *im;
6153 const char *file = NULL;
6154 bool just_best;
6155
6156 #ifndef _MSC_VER
6157 {
6158 struct timeval tm;
6159 gettimeofday(&tm, NULL);
6160 mus_set_rand_seed((unsigned long)(tm.tv_sec * 1000 + tm.tv_usec / 1000));
6161 }
6162 #endif
6163
6164 choice = Xen_integer_to_C_int(x_choice);
6165 if ((choice < ALL) || (choice > PRIME))
6166 choice = ALL;
6167
6168 n = Xen_integer_to_C_int(x_n);
6169
6170 if (Xen_is_integer(x_size))
6171 size = Xen_integer_to_C_int(x_size);
6172 else size = 3000;
6173
6174 if (Xen_is_double(x_increment))
6175 increment = Xen_real_to_C_double(x_increment);
6176 else increment = 0.06; /* was .03 */
6177
6178 counts = 50; /* 100? */
6179 orig_incr = increment;
6180 incr_mult = INCR_DOWN;
6181 file = "test.data";
6182 just_best = false;
6183
6184 if (Xen_is_vector(start_phases))
6185 {
6186 int i;
6187 initial_phases = (mus_float_t *)malloc(n * sizeof(mus_float_t));
6188 for (i = 0; i < n; i++)
6189 initial_phases[i] = (mus_float_t)Xen_real_to_C_double(Xen_vector_ref(start_phases, i));
6190 }
6191
6192 min_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
6193
6194 overall_min = saved_min(choice, n);
6195 #if 0
6196 if (overall_min < sqrt((double)n)) overall_min = sqrt((double)n);
6197 overall_min += .5;
6198 #endif
6199 temp_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
6200 diff_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
6201
6202 {
6203 int start, n1, day_counter, free_top, fft_size;
6204
6205 if (choice == ALL)
6206 n1 = n;
6207 else
6208 {
6209 if (choice != PRIME)
6210 n1 = n * 2;
6211 else n1 = primes[n];
6212 }
6213 fft_size = (int)pow(2.0, (int)ceil(log(FFT_MULT * n1) / log(2.0)));
6214 rl = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
6215 im = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
6216
6217 choices = (pk_data **)calloc(size, sizeof(pk_data *));
6218 free_choices = (pk_data **)calloc(size, sizeof(pk_data *));
6219
6220 for (start = 0; start < size; start++)
6221 {
6222 choices[start] = (pk_data *)calloc(1, sizeof(pk_data));
6223 choices[start]->phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
6224 }
6225
6226 free_top = 0;
6227 day_counter = 0;
6228 local_best = (mus_float_t)n;
6229 increment = orig_incr;
6230
6231 /* here to stay focussed,
6232 * for (k = 0; k < n; k++) choices[0]->phases[k] = initial_phases[k];
6233 * choices[0]->pk = get_peak(choice, fft_size, n, initial_phases, rl, im);
6234 * for (start = 1; start < size; start++)
6235 * etc
6236 * but this is not an improvement
6237 */
6238 for (start = 0; start < size; start++)
6239 {
6240 mus_float_t pk, local_pk = 100000.0;
6241 int k, init_try;
6242
6243 for (init_try = 0; init_try < INIT_TRIES; init_try++)
6244 {
6245 if (initial_phases)
6246 {
6247 for (k = 1; k < n; k++)
6248 temp_phases[k] = initial_phases[k] + local_random(increment) + local_random(increment);
6249 }
6250 else
6251 {
6252 for (k = 1; k < n; k++)
6253 temp_phases[k] = local_frandom(2.0);
6254 }
6255 pk = get_peak(choice, fft_size, n, temp_phases, rl, im);
6256
6257 if (pk < local_best)
6258 {
6259 local_best = pk;
6260 if ((!just_best) ||
6261 (pk < overall_min))
6262 {
6263 for (k = 1; k < n; k++) min_phases[k] = temp_phases[k];
6264 if (pk < overall_min)
6265 {
6266 FILE *ofile;
6267 if (file)
6268 ofile = fopen(file, "a");
6269 else ofile = stderr;
6270 fprintf(ofile, "%s, %d %f #r(", choice_name[choice], n, pk);
6271 for (k = 0; k < n - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
6272 fprintf(ofile, "%f)\n", min_phases[n - 1]);
6273 if (file) fclose(ofile);
6274 overall_min = pk;
6275 set_saved_min(choice, n, pk);
6276 }
6277 }
6278 }
6279
6280 if (pk < local_pk)
6281 {
6282 for (k = 1; k < n; k++) choices[start]->phases[k] = temp_phases[k];
6283 choices[start]->pk = pk;
6284 local_pk = pk;
6285 }
6286 }
6287 }
6288
6289 while (true)
6290 {
6291 int i, j = 0, k, len;
6292 mus_float_t sum = 0.0, avg;
6293
6294 len = size;
6295 day_counter++;
6296 for (i = 0; i < len; i++) sum += choices[i]->pk;
6297 avg = sum / len;
6298
6299 for (i = 0; i < len; i++)
6300 {
6301 pk_data *datum;
6302 datum = choices[i];
6303 choices[i] = NULL;
6304 if (datum->pk < avg)
6305 choices[j++] = datum;
6306 else free_choices[free_top++] = datum;
6307 }
6308
6309 for (i = 0, k = j; k < len; i++, k++)
6310 {
6311 pk_data *data;
6312 mus_float_t *phases;
6313 mus_float_t cur_min, temp_min = 100000.0, pk = 100000.0;
6314 int llen, local_try, ii, kk, local_tries;
6315 pk_data *new_pk;
6316
6317 if (i == j)
6318 i = 0;
6319
6320 data = choices[i];
6321 new_pk = free_choices[--free_top];
6322 cur_min = data->pk;
6323 phases = data->phases;
6324 llen = n;
6325 local_tries = RETRIES + day_counter * RETRY_MULT;
6326
6327 /* try to find a point nearby that is better */
6328 for (local_try = 0; (local_try < local_tries) && (pk >= cur_min); local_try++)
6329 {
6330 for (ii = 1; ii < llen; ii++)
6331 temp_phases[ii] = fmod(phases[ii] + local_random(increment) + local_random(increment), 2.0); /* not mus_frandom! */
6332 pk = get_peak(choice, fft_size, n, temp_phases, rl, im);
6333
6334 if (pk < temp_min)
6335 {
6336 temp_min = pk;
6337 new_pk->pk = pk;
6338 for (kk = 1; kk < llen; kk++) new_pk->phases[kk] = temp_phases[kk];
6339 }
6340 }
6341
6342 /* if a better point is found, try to follow the slopes */
6343 if (new_pk->pk < data->pk)
6344 {
6345 int happy = 3;
6346 for (kk = 1; kk < llen; kk++)
6347 diff_phases[kk] = new_pk->phases[kk] - data->phases[kk];
6348
6349 while (happy > 0)
6350 {
6351 for (kk = 1; kk < llen; kk++)
6352 temp_phases[kk] = fmod(new_pk->phases[kk] + local_frandom(diff_phases[kk]), 2.0); /* use frandom 30-mar-11 */
6353 pk = get_peak(choice, fft_size, n, temp_phases, rl, im);
6354
6355 if (pk < new_pk->pk)
6356 {
6357 new_pk->pk = pk;
6358 for (kk = 1; kk < llen; kk++) new_pk->phases[kk] = temp_phases[kk];
6359 happy = 3;
6360 }
6361 else happy--;
6362 }
6363 }
6364
6365 pk = new_pk->pk;
6366
6367 if (pk < local_best)
6368 {
6369 local_best = pk;
6370 if ((!just_best) ||
6371 (pk < overall_min))
6372 {
6373 for (kk = 1; kk < llen; kk++) min_phases[kk] = new_pk->phases[kk];
6374 if (pk < overall_min)
6375 {
6376 FILE *ofile;
6377 if (file)
6378 ofile = fopen(file, "a");
6379 else ofile = stderr;
6380 fprintf(ofile, "%s, %d %f #r(", choice_name[choice], n, pk);
6381 for (kk = 0; kk < llen - 1; kk++) fprintf(ofile, "%f ", min_phases[kk]);
6382 fprintf(ofile, "%f)\n", min_phases[llen - 1]);
6383 if (file) fclose(ofile);
6384 overall_min = pk;
6385 set_saved_min(choice, llen, pk);
6386 }
6387 }
6388
6389 day_counter = 0;
6390 }
6391 choices[k] = new_pk;
6392 }
6393
6394 if (day_counter < counts)
6395 {
6396 /* .9^50 = .005, so starting at .1 bottoms out at .0005
6397 * perhaps the counts variable should be (ceiling (log INCR_MIN incr_mult)) = 90 or so in the current case
6398 * incr_mult is currently always INCR_DOWN = .9
6399 */
6400 increment *= incr_mult;
6401 if (increment < INCR_MIN)
6402 {
6403 increment = INCR_MIN;
6404 }
6405 if (increment > INCR_MAX)
6406 {
6407 increment = INCR_MAX;
6408 incr_mult = INCR_DOWN;
6409 }
6410 }
6411 else break;
6412 }
6413 }
6414 free(temp_phases);
6415 free(diff_phases);
6416 free(rl);
6417 free(im);
6418 free(free_choices);
6419 if (initial_phases) free(initial_phases);
6420
6421 {
6422 int i;
6423 for (i = 0; i < size; i++)
6424 {
6425 free(choices[i]->phases);
6426 free(choices[i]);
6427 }
6428 free(choices);
6429 }
6430
6431 return(Xen_list_2(C_double_to_Xen_real(local_best),
6432 xen_make_vct(n, min_phases)));
6433 }
6434
6435
6436
6437 #if HAVE_SCHEME
6438 static s7_pointer g_phases_get_peak(s7_scheme *sc, s7_pointer args)
6439 {
6440 s7_int choice, i, m, n;
6441 int fft_size, fft_mult = 128, n1;
6442 s7_pointer phases;
6443 s7_pointer *elements;
6444 double pi2, mx;
6445 mus_float_t *rl, *im;
6446
6447 pi2 = M_PI / 2.0;
6448
6449 choice = s7_integer(s7_car(args));
6450 n = s7_integer(s7_cadr(args));
6451 phases = s7_caddr(args);
6452 elements = s7_vector_elements(phases);
6453
6454 if (choice == 0)
6455 n1 = n;
6456 else
6457 {
6458 if (choice == 3)
6459 n1 = primes[n];
6460 else n1 = 2 * n;
6461 }
6462
6463 fft_size = (int)pow(2.0, (int)ceil(log(fft_mult * n1) / log(2.0)));
6464 rl = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
6465 im = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
6466
6467 for (m = 0; m < n; m++)
6468 {
6469 double phi;
6470 int bin;
6471 phi = pi2 + M_PI * (s7_real(elements[m]));
6472 if (choice == 0)
6473 bin = m + 1;
6474 else
6475 {
6476 if (choice == 1)
6477 bin = 1 + (m * 2);
6478 else
6479 {
6480 if (choice == 2)
6481 {
6482 bin = m * 2;
6483 if (bin == 0) bin = 1;
6484 }
6485 else bin = primes[m];
6486 }
6487 }
6488 rl[bin] = cos(phi);
6489 im[bin] = sin(phi);
6490 }
6491
6492 mus_fft(rl, im, fft_size, -1);
6493
6494 mx = fabs(rl[0]);
6495 for (i = 1; i < fft_size; i++)
6496 {
6497 double tmp;
6498 tmp = fabs(rl[i]);
6499 if (tmp > mx)
6500 mx = tmp;
6501 }
6502
6503 free(rl);
6504 free(im);
6505
6506 return(s7_make_real(sc, mx));
6507 }
6508 #endif
6509
6510
6511
6512 Xen_wrap_6_optional_args(g_scan_channel_w, g_scan_channel)
6513 Xen_wrap_7_optional_args(g_map_channel_w, g_map_channel)
6514 #if (!HAVE_SCHEME)
6515 Xen_wrap_7_optional_args(g_map_chan_w, g_map_chan)
6516 Xen_wrap_6_optional_args(g_scan_chan_w, g_scan_chan)
6517 Xen_wrap_5_optional_args(g_find_channel_w, g_find_channel)
6518 #endif
6519 Xen_wrap_5_optional_args(g_count_matches_w, g_count_matches)
6520 Xen_wrap_4_optional_args(g_smooth_sound_w, g_smooth_sound)
6521 Xen_wrap_5_optional_args(g_smooth_channel_w, g_smooth_channel)
6522 Xen_wrap_no_args(g_smooth_selection_w, g_smooth_selection)
6523 Xen_wrap_no_args(g_delete_selection_and_smooth_w, g_delete_selection_and_smooth)
6524 Xen_wrap_5_optional_args(g_delete_samples_and_smooth_w, g_delete_samples_and_smooth)
6525 Xen_wrap_3_optional_args(g_reverse_sound_w, g_reverse_sound)
6526 Xen_wrap_5_optional_args(g_reverse_channel_w, g_reverse_channel)
6527 Xen_wrap_no_args(g_reverse_selection_w, g_reverse_selection)
6528 Xen_wrap_8_optional_args(g_swap_channels_w, g_swap_channels)
6529 Xen_wrap_4_optional_args(g_insert_silence_w, g_insert_silence)
6530 Xen_wrap_1_optional_arg(g_scale_selection_to_w, g_scale_selection_to)
6531 Xen_wrap_1_arg(g_scale_selection_by_w, g_scale_selection_by)
6532 Xen_wrap_3_optional_args(g_scale_to_w, g_scale_to)
6533 Xen_wrap_3_optional_args(g_scale_by_w, g_scale_by)
6534 Xen_wrap_2_optional_args(g_env_selection_w, g_env_selection)
6535 Xen_wrap_7_optional_args(g_env_sound_w, g_env_sound)
6536 Xen_wrap_6_optional_args(g_env_channel_w, g_env_channel)
6537 Xen_wrap_7_optional_args(g_env_channel_with_base_w, g_env_channel_with_base)
6538 Xen_wrap_7_optional_args(g_ramp_channel_w, g_ramp_channel)
6539 Xen_wrap_8_optional_args(g_xramp_channel_w, g_xramp_channel)
6540 Xen_wrap_3_optional_args(g_fft_w, g_fft)
6541 Xen_wrap_7_optional_args(g_snd_spectrum_w, g_snd_spectrum)
6542 Xen_wrap_5_optional_args(g_convolve_with_w, g_convolve_with)
6543 Xen_wrap_2_optional_args(g_convolve_selection_with_w, g_convolve_selection_with)
6544 Xen_wrap_5_optional_args(g_src_sound_w, g_src_sound)
6545 Xen_wrap_2_optional_args(g_src_selection_w, g_src_selection)
6546 Xen_wrap_6_optional_args(g_src_channel_w, g_src_channel)
6547 Xen_wrap_5_optional_args(g_pad_channel_w, g_pad_channel)
6548 Xen_wrap_9_optional_args(g_filter_channel_w, g_filter_channel)
6549 Xen_wrap_6_optional_args(g_filter_sound_w, g_filter_sound)
6550 Xen_wrap_3_optional_args(g_filter_selection_w, g_filter_selection)
6551 Xen_wrap_8_optional_args(g_clm_channel_w, g_clm_channel)
6552 Xen_wrap_no_args(g_sinc_width_w, g_sinc_width)
6553 Xen_wrap_1_arg(g_set_sinc_width_w, g_set_sinc_width)
6554
6555 Xen_wrap_5_optional_args(g_fpsap_w, g_fpsap)
6556
6557 #if HAVE_SCHEME
6558 static s7_pointer acc_sinc_width(s7_scheme *sc, s7_pointer args) {return(g_set_sinc_width(s7_cadr(args)));}
6559 #endif
6560
6561 void g_init_sig(void)
6562 {
6563 #if HAVE_SCHEME
6564 s7_pointer i, pcl_t;
6565 i = s7_make_symbol(s7, "integer?");
6566 pcl_t = s7_make_circular_signature(s7, 0, 1, s7_t(s7));
6567 /* asssert_sample means all positions are '(b i) and assert_channel (or edpos) means the snd/chn/edpos args are #t
6568 * so the signatures are almost useless here -- this should be changed! snd=<sound>, chn=int, edpos=int
6569 */
6570 #endif
6571
6572 Xen_define_typed_procedure(S_scan_channel, g_scan_channel_w, 1, 5, 0, H_scan_channel, pcl_t);
6573 Xen_define_typed_procedure(S_count_matches, g_count_matches_w, 1, 4, 0, H_count_matches, pcl_t);
6574 Xen_define_typed_procedure(S_map_channel, g_map_channel_w, 1, 6, 0, H_map_channel, pcl_t);
6575
6576 Xen_define_typed_procedure(S_smooth_sound, g_smooth_sound_w, 0, 4, 0, H_smooth_sound, pcl_t);
6577 Xen_define_typed_procedure(S_smooth_selection, g_smooth_selection_w, 0, 0, 0, H_smooth_selection, pcl_t);
6578 Xen_define_typed_procedure(S_delete_selection_and_smooth, g_delete_selection_and_smooth_w, 0, 0, 0, H_delete_selection_and_smooth, pcl_t);
6579 Xen_define_typed_procedure(S_delete_samples_and_smooth, g_delete_samples_and_smooth_w, 2, 3, 0, H_delete_samples_and_smooth, pcl_t);
6580 Xen_define_typed_procedure(S_reverse_sound, g_reverse_sound_w, 0, 3, 0, H_reverse_sound, pcl_t);
6581 Xen_define_typed_procedure(S_reverse_selection, g_reverse_selection_w, 0, 0, 0, H_reverse_selection, pcl_t);
6582 Xen_define_typed_procedure(S_swap_channels, g_swap_channels_w, 0, 8, 0, H_swap_channels, pcl_t);
6583 Xen_define_typed_procedure(S_insert_silence, g_insert_silence_w, 2, 2, 0, H_insert_silence, pcl_t);
6584
6585 Xen_define_typed_procedure(S_scale_selection_to, g_scale_selection_to_w, 0, 1, 0, H_scale_selection_to, pcl_t);
6586 Xen_define_typed_procedure(S_scale_selection_by, g_scale_selection_by_w, 1, 0, 0, H_scale_selection_by, pcl_t);
6587 Xen_define_typed_procedure(S_scale_to, g_scale_to_w, 0, 3, 0, H_scale_to, pcl_t);
6588 Xen_define_typed_procedure(S_scale_by, g_scale_by_w, 1, 2, 0, H_scale_by, pcl_t);
6589 Xen_define_typed_procedure(S_env_selection, g_env_selection_w, 1, 1, 0, H_env_selection, pcl_t);
6590 Xen_define_typed_procedure(S_env_sound, g_env_sound_w, 1, 6, 0, H_env_sound, pcl_t);
6591 Xen_define_typed_procedure(S_fft, g_fft_w, 2, 1, 0, H_fft, pcl_t);
6592 Xen_define_typed_procedure(S_snd_spectrum, g_snd_spectrum_w, 1, 6, 0, H_snd_spectrum, pcl_t);
6593 Xen_define_typed_procedure(S_convolve_with, g_convolve_with_w, 1, 4, 0, H_convolve_with, pcl_t);
6594 Xen_define_typed_procedure(S_convolve_selection_with, g_convolve_selection_with_w, 1, 1, 0, H_convolve_selection_with, pcl_t);
6595 Xen_define_typed_procedure(S_src_sound, g_src_sound_w, 1, 4, 0, H_src_sound, pcl_t);
6596 Xen_define_typed_procedure(S_src_selection, g_src_selection_w, 1, 1, 0, H_src_selection, pcl_t);
6597 Xen_define_typed_procedure(S_filter_channel, g_filter_channel_w, 1, 8, 0, H_filter_channel, pcl_t);
6598 Xen_define_typed_procedure(S_filter_sound, g_filter_sound_w, 1, 5, 0, H_filter_sound, pcl_t);
6599 Xen_define_typed_procedure(S_filter_selection, g_filter_selection_w, 1, 2, 0, H_filter_selection, pcl_t);
6600
6601 Xen_define_typed_procedure(S_reverse_channel, g_reverse_channel_w, 0, 5, 0, H_reverse_channel, pcl_t);
6602 Xen_define_typed_procedure(S_clm_channel, g_clm_channel_w, 1, 7, 0, H_clm_channel, pcl_t);
6603 Xen_define_typed_procedure(S_env_channel, g_env_channel_w, 1, 5, 0, H_env_channel, pcl_t);
6604 Xen_define_typed_procedure(S_env_channel_with_base, g_env_channel_with_base_w, 1, 6, 0, H_env_channel_with_base, pcl_t);
6605 Xen_define_typed_procedure(S_ramp_channel, g_ramp_channel_w, 2, 5, 0, H_ramp_channel, pcl_t);
6606 Xen_define_typed_procedure(S_xramp_channel, g_xramp_channel_w, 2, 6, 0, H_xramp_channel, pcl_t);
6607 Xen_define_typed_procedure(S_smooth_channel, g_smooth_channel_w, 0, 5, 0, H_smooth_channel, pcl_t);
6608 Xen_define_typed_procedure(S_src_channel, g_src_channel_w, 1, 5, 0, H_src_channel, pcl_t);
6609 Xen_define_typed_procedure(S_pad_channel, g_pad_channel_w, 2, 3, 0, H_pad_channel, pcl_t);
6610
6611 Xen_define_typed_dilambda(S_sinc_width, g_sinc_width_w, H_sinc_width,
6612 S_set S_sinc_width, g_set_sinc_width_w, 0, 0, 1, 0,
6613 s7_make_signature(s7, 1, i), s7_make_signature(s7, 2, i, i));
6614
6615 Xen_define_typed_procedure(S_fpsap, g_fpsap_w, 3, 2, 0, H_fpsap, pcl_t);
6616
6617 #if HAVE_SCHEME
6618 Xen_define_typed_procedure("phases-get-peak", g_phases_get_peak, 3, 0, 0, "", pcl_t);
6619
6620 s7_set_setter(s7, ss->sinc_width_symbol, s7_make_function(s7, "[acc-" S_sinc_width "]", acc_sinc_width, 2, 0, false, "accessor"));
6621 s7_set_documentation(s7, ss->sinc_width_symbol, "*sinc-width*: sampling rate conversion sinc width (10).");
6622
6623 gc_vect = s7_make_vector(s7, 4);
6624 s7_gc_protect(s7, gc_vect);
6625 #endif
6626
6627 #if (!HAVE_SCHEME)
6628 Xen_define_procedure(S_scan_chan, g_scan_chan_w, 1, 5, 0, H_scan_chan);
6629 Xen_define_procedure(S_find_channel, g_find_channel_w, 1, 4, 0, H_find_channel);
6630 Xen_define_procedure(S_map_chan, g_map_chan_w, 1, 6, 0, H_map_chan);
6631 #endif
6632 }
6633
6634 #if 0
6635 /* these work in snd-test, but are not faster */
6636
6637 (define* (scan-channel func (beg 0) dur snd chn edpos)
6638 (let ((end (if dur (min (+ beg dur) (framples snd chn)) (framples snd chn)))
6639 (rd (make-sampler beg snd chn 1 edpos)))
6640 (do ((pos beg (+ pos 1)))
6641 ((or (>= pos end)
6642 (func (next-sample rd)))
6643 (and (< pos end)
6644 pos)))))
6645
6646 (define* (count-matches func (beg 0) snd chn edpos)
6647 (let ((end (framples snd chn edpos))
6648 (matches 0)
6649 (reader (make-sampler beg snd chn 1 edpos)))
6650 (do ((i beg (+ i 1)))
6651 ((>= i end) matches)
6652 (if (func (next-sample reader))
6653 (set! matches (+ matches 1))))))
6654
6655
6656 (define-macro* (scan-channel-1 func (beg 0) dur snd chn edpos)
6657 (let ((end (if dur (min (+ beg dur) (framples snd chn)) (framples snd chn))))
6658 `(let ((rd (make-sampler ,beg ,snd ,chn 1 ,edpos))
6659 (f ,func))
6660 (define (call)
6661 (do ((pos ,beg (+ pos 1)))
6662 ((or (>= pos ,end)
6663 (f (next-sample rd)))
6664 (and (< pos ,end)
6665 pos))))
6666 (call))))
6667
6668 (define* (scan-channel-2 func (beg 0) dur snd chn edpos)
6669 (define* (uncons lst (res ()))
6670 (if (null? lst) res (uncons (cdr lst) (cons (list (caar lst) (cdar lst)) res))))
6671 (let ((end (if dur (min (+ beg dur) (framples snd chn)) (framples snd chn)))
6672 (source (procedure-source func))
6673 (e (funclet func)))
6674 (let ((arg (caadr source))
6675 (body (cddr source))
6676 (new-e (if (eq? e (rootlet)) () (uncons (let->list e))))
6677 (rd (make-sampler beg snd chn 1 edpos)))
6678 (define call (apply let new-e
6679 `((lambda ()
6680 (do ((pos ,beg (+ pos 1))
6681 (,arg (next-sample ,rd) (next-sample ,rd)))
6682 ((or (>= pos ,end)
6683 (begin ,@body))
6684 (and (< pos ,end)
6685 pos)))))))
6686 (call))))
6687
6688
6689 */
6690 #endif
6691
6692
6693
6694