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