1 #include "snd.h"
2 #include "sndlib-strings.h"
3 #include "clm2xen.h"
4 
get_sp_1(int index)5 static snd_info *get_sp_1(int index)
6 {
7   if ((index >= 0) &&
8       (index < ss->max_sounds) &&
9       (snd_ok(ss->sounds[index])))
10     return(ss->sounds[index]);
11 
12   return(NULL);
13 }
14 
get_sp(Xen snd)15 snd_info *get_sp(Xen snd)
16 {
17   if (xen_is_sound(snd))
18     return(get_sp_1(xen_sound_to_int(snd)));
19 
20 #if (!HAVE_SCHEME)
21   if (Xen_is_integer(snd))
22     return(get_sp_1(Xen_integer_to_C_int(snd)));
23 #else
24   if (Xen_is_integer(snd))
25     {
26       s7_int p;
27       p = s7_integer(snd);
28       if ((p < 0) ||
29 	  (p > ss->max_sounds))
30 	return(NULL);
31       return(get_sp_1((int)p));
32     }
33 #endif
34 
35   if ((Xen_is_boolean(snd)) || (!Xen_is_bound(snd)))  /* use default sound, if any */
36     return(any_selected_sound());
37 
38   return(NULL);
39 }
40 
41 
snd_new_file(const char * newname,int chans,int srate,mus_sample_t sample_type,mus_header_t header_type,const char * new_comment,mus_long_t samples)42 snd_info *snd_new_file(const char *newname, int chans, int srate, mus_sample_t sample_type,
43 		       mus_header_t header_type, const char *new_comment, mus_long_t samples)
44 {
45   /* caller checks newname != null, and runs overwrite hook */
46   if (mus_header_writable(header_type, sample_type))
47     {
48       io_error_t err;
49       err = snd_write_header(newname, header_type, srate, chans, samples * chans, sample_type, new_comment, NULL);
50       if (err != IO_NO_ERROR)
51 	snd_error("%s %s: %s",
52 		  io_error_name(err),
53 		  newname,
54 		  snd_io_strerror());
55       else
56 	{
57 	  int chan;
58 	  mus_long_t size;
59 	  /* send out the initial samples */
60 	  chan = snd_reopen_write(newname);
61 	  lseek(chan, mus_header_data_location(), SEEK_SET);
62 	  size = chans * mus_samples_to_bytes(sample_type, samples);
63 	  if (size > 0)
64 	    {
65 	      ssize_t bytes;
66 	      unsigned char *buf;
67 	      buf = (unsigned char *)calloc(size, sizeof(unsigned char));
68 	      bytes = write(chan, buf, size);
69 	      if (bytes == 0)
70 		fprintf(stderr, "%s: write error", newname);
71 	      free(buf);
72 	    }
73 	  snd_close(chan, newname);
74 	  ss->open_requestor = FROM_NEW_FILE_DIALOG;
75 	  return(sound_is_silence(snd_open_file(newname, FILE_READ_WRITE)));
76 	}
77     }
78   else
79     snd_error("%s: can't write %s header with %s sample type",
80 	      newname,
81 	      mus_header_type_name(header_type),
82 	      mus_sample_type_name(sample_type));
83   return(NULL);
84 }
85 
86 
87 /* ---------------- peak amp envs ---------------- */
88 
89 typedef struct env_state {
90   int slice, edpos;
91   mus_long_t samples, m;
92   peak_env_info *ep;
93   snd_fd *sf;
94 
95   unsigned char *direct_data;
96   mus_sample_t format;
97   int chans, bytes, fd;
98   bool file_open;
99 } env_state;
100 
101 
free_env_state(env_state * es)102 static env_state *free_env_state(env_state *es)
103 {
104   if (es)
105     {
106       if (es->sf)
107 	es->sf = free_snd_fd(es->sf);
108       if (es->file_open)
109 	{
110 	  close(es->fd);
111 	  es->file_open = false;
112 	}
113       if (es->direct_data)
114 	{
115 	  free(es->direct_data);
116 	  es->direct_data = NULL;
117 	}
118       free(es);
119     }
120   return(NULL);
121 }
122 
123 
free_peak_env_info(peak_env_info * ep)124 peak_env_info *free_peak_env_info(peak_env_info *ep)
125 {
126   if (ep)
127     {
128       if (ep->data_max) {free(ep->data_max); ep->data_max = NULL;}
129       if (ep->data_min) {free(ep->data_min); ep->data_min = NULL;}
130       free(ep);
131     }
132   return(NULL);
133 }
134 
135 
free_peak_env(chan_info * cp,int pos)136 peak_env_info *free_peak_env(chan_info *cp, int pos)
137 {
138   /* can be either during channel close, or premature work proc removal */
139   if ((cp) &&
140       (cp->edits) &&
141       (pos < cp->edit_size) &&
142       (cp->edits[pos]->peak_env))
143     {
144       free_peak_env_info(cp->edits[pos]->peak_env);
145       cp->edits[pos]->peak_env = NULL;
146     }
147   return(NULL);
148 }
149 
150 
151 /* during processing, cp->peak_env_state -> env_state for that channel
152  *  cp->peak_env_in_progress is the associated X work proc
153  */
154 
free_peak_env_state(chan_info * cp)155 void free_peak_env_state(chan_info *cp)
156 {
157   /* env info is tied into cp edit list peak envs immediately upon env start, released via normal cp cleanups */
158   /* this function just cleans up the current work proc stuff (amp_env in this case can be incomplete) */
159   if (cp)
160     {
161       cp->peak_env_state = free_env_state(cp->peak_env_state);
162       cp->peak_env_in_progress = 0;
163     }
164 }
165 
166 #define MIN_INIT 1000000.0
167 #define MAX_INIT -1000000.0
168 #define MAX_ENV_SIZE (1 << 30)
169 
make_env_state(chan_info * cp,mus_long_t samples)170 static env_state *make_env_state(chan_info *cp, mus_long_t samples)
171 {
172   int pos, orig_pos;
173   peak_env_info *ep;
174   env_state *es;
175 
176   if (samples <= 0) return(NULL);
177   if (samples > MAX_ENV_SIZE) return(NULL);
178   stop_peak_env(cp);
179   pos = cp->edit_ctr;
180   orig_pos = cp->edits[pos]->edpos; /* don't assume we're editing the preceding state! */
181   es = (env_state *)calloc(1, sizeof(env_state)); /* only creation point */
182   es->file_open = false;
183   es->samples = samples;
184   es->slice = 0;
185   es->edpos = pos;
186   es->m = 0;
187 
188   es->direct_data = NULL;
189 
190   if (cp->edits[pos]->peak_env)
191     {
192       es->ep = cp->edits[pos]->peak_env;
193       ep = es->ep;
194     }
195   else
196     {
197       bool happy = false;
198       es->ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
199       ep = es->ep;
200       if (pos > 0)
201 	{
202 	  peak_env_info *old_ep;
203 	  old_ep = cp->edits[orig_pos]->peak_env;
204 
205 	  if ((old_ep) &&
206 	      (old_ep->completed))
207 	    {
208 	      mus_long_t old_samples;
209 
210 	      /* here in many cases, the underlying edit's amp env has most of the data we need.
211 	       * cp->edits[cp->edit_ctr] describes the current edit, with beg and end, so in the
212 	       * simplest case, we can just copy to the bin representing beg, and from the bin
213 	       * representing end (setting ep->top_bin and ep->bin); if the file's length has
214 	       * changed dramatically, we need to do it all.  fmin/fmax need to be set as we copy.
215 	       * as-one-edit can mess this up...
216 	       */
217 
218 	      old_samples = cp->edits[orig_pos]->samples;
219 	      if (snd_abs_mus_long_t(samples - old_samples) < (samples / 2))
220 		{
221 		  mus_long_t start, end;
222 		  start = edit_changes_begin_at(cp, cp->edit_ctr);
223 		  end = edit_changes_end_at(cp, cp->edit_ctr);
224 
225 		  if (snd_abs_mus_long_t(end - start) < (samples / 2))
226 		    {
227 		      int i, start_bin;
228 
229 		      /* here we'll try to take advantage of an existing envelope */
230 		      old_ep = cp->edits[orig_pos]->peak_env;
231 		      ep->samps_per_bin = old_ep->samps_per_bin;
232 		      ep->peak_env_size = (int)(ceil((double)(es->samples) / (double)(ep->samps_per_bin)));
233 		      ep->data_max = (mus_float_t *)calloc(ep->peak_env_size, sizeof(mus_float_t));
234 		      ep->data_min = (mus_float_t *)calloc(ep->peak_env_size, sizeof(mus_float_t));
235 		      start_bin = (int)(start / ep->samps_per_bin);
236 		      ep->fmin = old_ep->data_min[0];
237 		      ep->fmax = old_ep->data_max[0];
238 		      for (i = 0; i < start_bin; i++)
239 			{
240 			  ep->data_min[i] = old_ep->data_min[i];
241 			  ep->data_max[i] = old_ep->data_max[i];
242 			  if (ep->data_min[i] < ep->fmin) ep->fmin = ep->data_min[i];
243 			  if (ep->data_max[i] > ep->fmax) ep->fmax = ep->data_max[i];
244 			}
245 		      ep->bin = start_bin;
246 		      if (end != 0)
247 			{
248 			  int j, end_bin, old_end_bin;
249 			  old_end_bin = (int)(end / old_ep->samps_per_bin);
250 			  end += (samples - old_samples);
251 			  end_bin = (int)(end / ep->samps_per_bin);
252 			  if (end_bin <= 0)
253 			    {
254 			      old_end_bin += (1 - end_bin);
255 			      end_bin = 1;
256 			    }
257 
258 			  for (i = end_bin, j = old_end_bin; (i < ep->peak_env_size) && (j < old_ep->peak_env_size); i++, j++)
259 			    {
260 			      ep->data_min[i] = old_ep->data_min[j];
261 			      ep->data_max[i] = old_ep->data_max[j];
262 			      if (ep->data_min[i] < ep->fmin) ep->fmin = ep->data_min[i];
263 			      if (ep->data_max[i] > ep->fmax) ep->fmax = ep->data_max[i];
264 			    }
265 			  ep->top_bin = end_bin;
266 			}
267 		      else ep->top_bin = 0;
268 		      happy = true;
269 		    }
270 		}
271 	    }
272 	}
273       if (!happy)
274 	{
275 	  int val;
276 	  /* we want samps_per_bin to be useful over a wide range of file sizes */
277 	  /* 160e6 = about a hour at 44KHz */
278 
279 	  val = (int)(log((double)(es->samples)));
280 	  if (val > 20) val = 20;
281 	  ep->peak_env_size = snd_int_pow2(val);
282 	  ep->samps_per_bin = (int)(ceil((double)(es->samples) / (double)(ep->peak_env_size)));
283 	  ep->data_max = (mus_float_t *)calloc(ep->peak_env_size, sizeof(mus_float_t));
284 	  ep->data_min = (mus_float_t *)calloc(ep->peak_env_size, sizeof(mus_float_t));
285 	  ep->bin = 0;
286 	  ep->top_bin = 0;
287 	  ep->fmin = 10000000.0;
288 	  ep->fmax = -10000000.0;
289 	  /* preset as much as possible of the envelope */
290 	}
291       cp->edits[pos]->peak_env = ep;
292       ep->completed = false;
293     }
294   es->sf = NULL;
295   return(es);
296 }
297 
298 
start_peak_env_state(chan_info * cp)299 void start_peak_env_state(chan_info *cp)
300 {
301   cp->peak_env_state = make_env_state(cp, current_samples(cp));
302 }
303 
304 
305 
tick_peak_env(chan_info * cp,env_state * es)306 static bool tick_peak_env(chan_info *cp, env_state *es)
307 {
308   peak_env_info *ep;
309 
310   ep = es->ep;
311   if (es->slice == 0)
312     {
313       int n, sb, lm;
314       mus_long_t samps_to_read;
315 
316       if (ep->top_bin != 0)
317 	lm = (ep->top_bin - ep->bin + 1);
318       else lm = (ep->peak_env_size - ep->bin);
319       if (lm <= 0) lm = 1;
320 
321       samps_to_read = (mus_long_t)lm * (mus_long_t)(ep->samps_per_bin);
322       if (samps_to_read > 1000000)
323 	{
324 	  lm = 1000000 / ep->samps_per_bin;
325 	  samps_to_read = (mus_long_t)lm * (mus_long_t)(ep->samps_per_bin);
326 	}
327 
328       sb = ep->bin;
329       if (sb >= ep->peak_env_size)
330 	{
331 	  /* oops... */
332 	  es->slice++;
333 	  if (es->sf)
334 	    es->sf = free_snd_fd(es->sf);
335 	  if (es->direct_data)
336 	    {
337 	      free(es->direct_data);
338 	      es->direct_data = NULL;
339 	    }
340 	  ep->completed = true;
341 	  return(true);
342 	}
343 
344       if ((!es->sf) &&
345 	  (!es->direct_data))
346 	{
347 	  if ((cp->edit_ctr == 0) &&
348 	      (cp->sound) &&
349 	      (cp->sound->inuse == SOUND_NORMAL) &&
350 	      (cp->sound->hdr) &&
351 	      (cp->sound->nchans <= 4) &&
352 	      (cp->sounds) &&
353 	      (cp->sounds[0]) &&
354 	      (cp->sounds[0]->io))
355 	    {
356 	      es->fd = mus_file_open_read(cp->sound->filename);
357 	      if (es->fd == -1)
358 		{
359 		  snd_warning("%s no longer exists!", cp->sound->filename);
360 		  return(true);
361 		}
362 	      es->file_open = true;
363 	      lseek(es->fd, cp->sound->hdr->data_location, SEEK_SET);
364 
365 	      es->format = cp->sound->hdr->sample_type;
366 	      es->chans = cp->sound->nchans;
367 	      es->bytes = ep->samps_per_bin * mus_bytes_per_sample(es->format) * es->chans;
368 	      es->direct_data = (unsigned char *)malloc(es->bytes * lm);
369 	    }
370 	  else es->sf = init_sample_read_any(ep->bin * ep->samps_per_bin, cp, READ_FORWARD, es->edpos);
371 	}
372 
373       if (!es->direct_data)
374 	{
375 	  snd_fd *sfd;
376 	  sfd = es->sf;
377 	  if (!sfd) return(false);
378 
379 	  for (n = 0; (n < lm) && (sb < ep->peak_env_size); n++, sb++)
380 	    {
381 	      mus_float_t ymin, ymax, val;
382 	      int i, lim;
383 	      val = read_sample(sfd);
384 	      ymin = val;
385 	      ymax = val;
386 	      i = 1;
387 	      lim = ep->samps_per_bin - 4;
388 	      while (i <= lim)
389 		{
390 		  val = read_sample(sfd);
391 		  if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
392 		  val = read_sample(sfd);
393 		  if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
394 		  val = read_sample(sfd);
395 		  if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
396 		  val = read_sample(sfd);
397 		  if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
398 		  i += 4;
399 		}
400 	      for (; i < ep->samps_per_bin; i++)
401 		{
402 		  val = read_sample(sfd);
403 		  if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
404 		}
405 	      ep->data_max[sb] = ymax;
406 	      ep->data_min[sb] = ymin;
407 
408 	      if (ymin < ep->fmin) ep->fmin = ymin;
409 	      if (ymax > ep->fmax) ep->fmax = ymax;
410 	    }
411 	}
412       else
413 	{
414 	  ssize_t bytes_read;
415 
416 	  /* there might be trailing chunks, so we have to keep track of es->samples (Tito Latini 2-Feb-17) */
417 	  bytes_read = es->samples * mus_bytes_per_sample(es->format) * es->chans;
418 	  if (bytes_read > (lm * es->bytes))
419 	    bytes_read = lm * es->bytes;
420 	  bytes_read = read(es->fd, (char *)(es->direct_data), bytes_read);
421 	  if (bytes_read < lm * es->bytes)
422 	    {
423 	      int zero_byte;
424 	      zero_byte = mus_sample_type_zero(es->format);
425 	      if ((zero_byte == 0) ||
426 		  ((es->format != MUS_UBSHORT) &&
427 		   (es->format != MUS_ULSHORT)))
428 		memset((void *)(es->direct_data + bytes_read), zero_byte, lm * es->bytes - bytes_read);
429 	      else /* MUS_UB|LSHORT 32768 or 128(as a short)=>0 */
430 		{
431 		  mus_long_t i, start, len;
432 		  unsigned short *buf;
433 
434 		  /* (with-sound (:sample-type mus-ubshort) (fm-violin 0 2 440 .1)) */
435 
436 		  buf = (unsigned short *)(es->direct_data);
437 		  start = bytes_read / 2;
438 		  len = lm * es->bytes / 2;
439 		  for (i = start; i < len; i++)
440 		    buf[i] = (unsigned short)zero_byte;
441 		}
442 	    }
443 
444 	  for (n = 0; (n < lm) && (sb < ep->peak_env_size); n++, sb++)
445 	    {
446 	      mus_float_t cur_min = 0.0, cur_max = 0.0;
447 	      mus_samples_bounds((unsigned char *)(es->direct_data + es->bytes * n), es->bytes, cp->chan, es->chans, es->format, &cur_min, &cur_max);
448 
449 	      ep->data_max[sb] = cur_max;
450 	      ep->data_min[sb] = cur_min;
451 
452 	      if (cur_min < ep->fmin) ep->fmin = cur_min;
453 	      if (cur_max > ep->fmax) ep->fmax = cur_max;
454 	    }
455 	}
456 
457       es->m += samps_to_read;
458       ep->bin += lm;
459       if ((es->m >= es->samples) ||
460 	  ((ep->top_bin > 0) && (ep->bin >= ep->top_bin))) /* this applies to partial amp envs */
461 	{
462 	  es->slice++;
463 
464 	  if (es->sf)
465 	    es->sf = free_snd_fd(es->sf);
466 
467 	  if (es->direct_data)
468 	    {
469 	      free(es->direct_data);
470 	      es->direct_data = NULL;
471 	    }
472 	  ep->completed = true;
473 	  return(true);
474 	}
475       return(false);
476     }
477   else
478     {
479       ep->completed = true;
480       return(true);
481     }
482 }
483 
finish_peak_env(chan_info * cp)484 void finish_peak_env(chan_info *cp)
485 {
486   if ((cp->peak_env_in_progress) &&
487       (cp->peak_env_state))
488     {
489       while (!(tick_peak_env(cp, cp->peak_env_state))) ; /* finish peak-env scan */
490       enved_reflect_peak_env_completion(cp->sound);
491       free_peak_env_state(cp);
492     }
493 }
494 
495 
get_peak_env(any_pointer_t ptr)496 idle_func_t get_peak_env(any_pointer_t ptr)
497 {
498   /* calculate the amp env of channel */
499   chan_info *cp = (chan_info *)ptr;
500   env_state *es;
501   int pos;
502 
503   if (!cp) return(BACKGROUND_QUIT);
504 
505   pos = cp->edit_ctr;
506   if ((pos == -1) ||
507       (cp->active < CHANNEL_HAS_EDIT_LIST))
508     {
509       free_peak_env_state(cp);
510       return(BACKGROUND_QUIT);
511     }
512 
513   if (!(cp->peak_env_state))
514     cp->peak_env_state = make_env_state(cp, current_samples(cp));
515 
516   es = cp->peak_env_state;
517   if (es)
518     {
519       if (tick_peak_env(cp, es))
520 	{
521 	  free_peak_env_state(cp);
522 	  enved_reflect_peak_env_completion(cp->sound);
523 	  if (cp->waiting_to_make_graph)
524 	    {
525 	      cp->waiting_to_make_graph = false;
526 	      cp->new_peaks = true;
527 	      update_graph(cp);
528 	      cp->new_peaks = false;
529 	    }
530 	  return(BACKGROUND_QUIT);
531 	}
532       else return(BACKGROUND_CONTINUE);
533     }
534   return(BACKGROUND_QUIT);
535 }
536 
537 
peak_env_maxamp_ok(chan_info * cp,int edpos)538 bool peak_env_maxamp_ok(chan_info *cp, int edpos)
539 {
540   if (cp)
541     {
542       peak_env_info *ep;
543       ep = cp->edits[edpos]->peak_env;
544       return((ep) && (ep->completed));
545     }
546   return(false);
547 }
548 
549 
peak_env_maxamp(chan_info * cp,int edpos)550 mus_float_t peak_env_maxamp(chan_info *cp, int edpos)
551 {
552   peak_env_info *ep;
553   mus_float_t ymax;
554   ep = cp->edits[edpos]->peak_env;
555   ymax = -ep->fmin;
556   if (ymax < ep->fmax)
557     return(ep->fmax);
558   return(ymax);
559 }
560 
561 
peak_env_usable(chan_info * cp,mus_float_t samples_per_pixel,mus_long_t hisamp,bool start_new,int edit_pos,bool finish_env)562 bool peak_env_usable(chan_info *cp, mus_float_t samples_per_pixel, mus_long_t hisamp, bool start_new, int edit_pos, bool finish_env)
563 {
564   peak_env_info *ep;
565 
566 #if USE_NO_GUI
567   return(false);
568 #endif
569 
570   if (!(cp->edits)) return(false);
571 
572   ep = cp->edits[edit_pos]->peak_env;
573   if (ep)
574     {
575       int bin;
576       bin = (int)(hisamp / ep->samps_per_bin);
577       if ((ep->completed) ||
578 	  (bin < ep->bin) ||
579 	  ((ep->top_bin != 0) && (bin > ep->top_bin)))
580 	return(samples_per_pixel >= (mus_float_t)(ep->samps_per_bin));
581     }
582 
583   if ((finish_env) && (cp->peak_env_in_progress) && (cp->peak_env_state))
584     {
585       /* caller wants data, but a read is in progress -- finish it as quickly as possible */
586       finish_peak_env(cp);
587       if (cp->waiting_to_make_graph)
588 	{
589 	  cp->waiting_to_make_graph = false;
590 	  update_graph(cp);
591 	}
592       return(peak_env_usable(cp, samples_per_pixel, hisamp, start_new, edit_pos, false));
593     }
594 
595   if ((start_new) &&
596       (!(cp->peak_env_in_progress)) &&
597       (current_samples(cp) > PEAK_ENV_CUTOFF) &&
598       (cp->sound->short_filename))             /* region browser jumped in too soon during autotest */
599     start_peak_env(cp);
600   return(false);
601 }
602 
603 
local_grf_y(mus_float_t val,axis_info * ap)604 static short local_grf_y(mus_float_t val, axis_info *ap)
605 {
606   if (val >= ap->y1) return(ap->y_axis_y1);
607   if (val <= ap->y0) return(ap->y_axis_y0);
608   return((short)(ap->y_base + val * ap->y_scale));
609 }
610 
611 
peak_env_graph(chan_info * cp,mus_float_t samples_per_pixel,int srate)612 int peak_env_graph(chan_info *cp, mus_float_t samples_per_pixel, int srate)
613 {
614   mus_float_t step, x, pinc = 0.0;
615   double xf, xk;
616   mus_float_t ymin, ymax;
617   int xi;
618   int j = 0;
619   mus_long_t i;
620   peak_env_info *ep;
621   axis_info *ap;
622 
623   ap = cp->axis;
624   ep = cp->edits[cp->edit_ctr]->peak_env;
625   step = samples_per_pixel / (mus_float_t)(ep->samps_per_bin);
626   xf = (double)(ap->losamp) / (double)(ep->samps_per_bin);
627   x = ap->x0;
628   xi = grf_x(x, ap);
629   i = ap->losamp;
630   xk = (double)i;
631   if (cp->printing) pinc = (mus_float_t)samples_per_pixel / (mus_float_t)srate;
632   ymin = ep->fmax;
633   ymax = ep->fmin;
634 
635   while (i <= ap->hisamp)
636     {
637       int k, kk;
638       k = (int)xf;
639       xf += step;
640       kk = (int)xf;
641       if (kk >= ep->peak_env_size)
642 	{
643 	  kk = ep->peak_env_size - 1;
644           if (k > kk) k = kk; /* make sure we get a value below */
645 	}
646       for (; k <= kk; k++)
647 	{
648 	  if (ep->data_min[k] < ymin) ymin = ep->data_min[k];
649 	  if (ep->data_max[k] > ymax) ymax = ep->data_max[k];
650 	}
651       xk += samples_per_pixel;
652       i = (mus_long_t)xk;
653       set_grf_points(xi, j,
654 		     local_grf_y(ymin, ap),
655 		     local_grf_y(ymax, ap));
656       if (cp->printing)
657 	{
658 	  x += pinc;
659 	  ps_set_grf_points(x, j, ymin, ymax);
660 	}
661       xi++;
662       j++;
663       if (j >= POINT_BUFFER_SIZE) break;
664       ymin = ep->fmax;
665       ymax = ep->fmin;
666     }
667   return(j);
668 }
669 
670 
peak_env_partial_graph(chan_info * cp,mus_long_t beg,mus_long_t end,mus_float_t samples_per_pixel,int srate)671 int peak_env_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end, mus_float_t samples_per_pixel, int srate)
672 {
673   mus_float_t step, x;
674   double xf, xk;
675   mus_float_t ymin, ymax;
676   int xi;
677   int j = 0;
678   mus_long_t i;
679   peak_env_info *ep;
680   axis_info *ap;
681 
682   ap = cp->axis;
683   ep = cp->edits[cp->edit_ctr]->peak_env;
684   step = samples_per_pixel / (mus_float_t)(ep->samps_per_bin);
685   xf = (double)(beg) / (double)(ep->samps_per_bin);
686   x = beg / srate;
687   xi = grf_x(x, ap);
688   i = beg;
689   xk = (double)i;
690 
691   ymin = ep->fmax;
692   ymax = ep->fmin;
693 
694   while (i <= end)
695     {
696       int k, kk;
697       k = (int)xf;
698       xf += step;
699       kk = (int)xf;
700       if (kk >= ep->peak_env_size)
701 	kk = ep->peak_env_size - 1;
702       for (; k <= kk; k++)
703 	{
704 	  if (ep->data_min[k] < ymin) ymin = ep->data_min[k];
705 	  if (ep->data_max[k] > ymax) ymax = ep->data_max[k];
706 	}
707       xk += samples_per_pixel;
708       i = (mus_long_t)xk;
709       set_grf_points(xi, j,
710 		     local_grf_y(ymin, ap),
711 		     local_grf_y(ymax, ap));
712       xi++;
713       j++;
714       if (j >= POINT_BUFFER_SIZE) break;
715       ymin = ep->fmax;
716       ymax = ep->fmin;
717     }
718   return(j);
719 }
720 
721 
peak_env_scale_by(chan_info * cp,mus_float_t scl,int pos)722 void peak_env_scale_by(chan_info *cp, mus_float_t scl, int pos)
723 {
724   peak_env_info *old_ep;
725   old_ep = cp->edits[pos]->peak_env;
726   if ((old_ep) && (old_ep->completed))
727     {
728       int i;
729       peak_env_info *new_ep;
730       new_ep = cp->edits[cp->edit_ctr]->peak_env;
731       if ((new_ep) &&
732 	  (new_ep->peak_env_size != old_ep->peak_env_size))
733 	new_ep = free_peak_env(cp, cp->edit_ctr);
734       if (!new_ep)
735 	{
736 	  new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
737 	  new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
738 	  new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
739 	}
740       new_ep->peak_env_size = old_ep->peak_env_size;
741       new_ep->samps_per_bin = old_ep->samps_per_bin;
742       if (scl >= 0.0)
743 	{
744 	  new_ep->fmin = old_ep->fmin * scl;
745 	  new_ep->fmax = old_ep->fmax * scl;
746 	  for (i = 0; i < new_ep->peak_env_size; i++)
747 	    {
748 	      new_ep->data_min[i] = old_ep->data_min[i] * scl;
749 	      new_ep->data_max[i] = old_ep->data_max[i] * scl;
750 	    }
751 	}
752       else
753 	{
754 	  new_ep->fmax = old_ep->fmin * scl;
755 	  new_ep->fmin = old_ep->fmax * scl;
756 	  for (i = 0; i < new_ep->peak_env_size; i++)
757 	    {
758 	      new_ep->data_max[i] = old_ep->data_min[i] * scl;
759 	      new_ep->data_min[i] = old_ep->data_max[i] * scl;
760 	    }
761 	}
762       new_ep->completed = true;
763       new_ep->bin = old_ep->bin;
764       new_ep->top_bin = old_ep->top_bin;
765       cp->edits[cp->edit_ctr]->peak_env = new_ep;
766     }
767 }
768 
769 
pick_one_bin(peak_env_info * ep,int bin,mus_long_t cursamp,chan_info * cp,int edpos)770 void pick_one_bin(peak_env_info *ep, int bin, mus_long_t cursamp, chan_info *cp, int edpos)
771 {
772   snd_fd *sf;
773   int n;
774   mus_float_t val, ymin, ymax;
775 
776   /* here we have to read the current bin using the current fragments */
777   sf = init_sample_read_any(cursamp, cp, READ_FORWARD, edpos);
778   if (!sf) return;
779 
780   val = read_sample(sf);
781   ymin = val;
782   ymax = val;
783 
784   for (n = 1; n < ep->samps_per_bin; n++)
785     {
786       val = read_sample(sf);
787       if (ymin > val) ymin = val;
788       if (ymax < val) ymax = val;
789     }
790 
791   ep->data_max[bin] = ymax;
792   ep->data_min[bin] = ymin;
793   free_snd_fd(sf);
794 }
795 
796 
peak_env_scale_selection_by(chan_info * cp,mus_float_t scl,mus_long_t beg,mus_long_t num,int pos)797 void peak_env_scale_selection_by(chan_info *cp, mus_float_t scl, mus_long_t beg, mus_long_t num, int pos)
798 {
799   peak_env_info *old_ep;
800 
801   old_ep = cp->edits[pos]->peak_env;
802   if ((old_ep) && (old_ep->completed))
803     {
804       mus_float_t fmax = MAX_INIT, fmin = MIN_INIT;
805       mus_long_t cursamp, start, end;
806       int i;
807       peak_env_info *new_ep;
808 
809       new_ep = cp->edits[cp->edit_ctr]->peak_env;
810       if ((new_ep) &&
811 	  (new_ep->peak_env_size != old_ep->peak_env_size))
812 	new_ep = free_peak_env(cp, cp->edit_ctr);
813 
814       if (!new_ep)
815 	{
816 	  new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
817 	  new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
818 	  new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
819 	}
820 
821       new_ep->peak_env_size = old_ep->peak_env_size;
822       new_ep->samps_per_bin = old_ep->samps_per_bin;
823       end = beg + num - 1;
824       start = beg - new_ep->samps_per_bin;
825 
826       for (i = 0, cursamp = 0; i < new_ep->peak_env_size; i++, cursamp += new_ep->samps_per_bin)
827 	{
828 	  if ((cursamp >= end) || (cursamp <= start))
829 	    {
830 	      new_ep->data_min[i] = old_ep->data_min[i];
831 	      new_ep->data_max[i] = old_ep->data_max[i];
832 	    }
833 	  else
834 	    {
835 	      /* if segment is entirely in scaled section, just scale it */
836 	      if ((cursamp >= beg) && ((cursamp + new_ep->samps_per_bin) <= end))
837 		{
838 		  if (scl >= 0.0)
839 		    {
840 		      new_ep->data_max[i] = old_ep->data_max[i] * scl;
841 		      new_ep->data_min[i] = old_ep->data_min[i] * scl;
842 		    }
843 		  else
844 		    {
845 		      new_ep->data_max[i] = old_ep->data_min[i] * scl;
846 		      new_ep->data_min[i] = old_ep->data_max[i] * scl;
847 		    }
848 		}
849 	      else pick_one_bin(new_ep, i, cursamp, cp, cp->edit_ctr);
850 	    }
851 	  if (fmin > new_ep->data_min[i]) fmin = new_ep->data_min[i];
852 	  if (fmax < new_ep->data_max[i]) fmax = new_ep->data_max[i];
853 	}
854 
855       new_ep->fmin = fmin;
856       new_ep->fmax = fmax;
857       new_ep->completed = true;
858       new_ep->bin = old_ep->bin;
859       new_ep->top_bin = old_ep->top_bin;
860       cp->edits[cp->edit_ctr]->peak_env = new_ep;
861     }
862 }
863 
864 
peak_env_section(chan_info * cp,mus_long_t beg,mus_long_t num,int edpos)865 peak_env_info *peak_env_section(chan_info *cp, mus_long_t beg, mus_long_t num, int edpos)
866 {
867   /* used in snd-region.c to create the region peak amp env */
868   peak_env_info *old_ep, *new_ep = NULL;
869   mus_float_t fmax = MAX_INIT, fmin = MIN_INIT;
870   int i, j;
871   mus_long_t cursamp, start, end;
872 
873   old_ep = cp->edits[edpos]->peak_env;
874   if (!old_ep) return(NULL);
875 
876   new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
877   new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
878   new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
879   new_ep->peak_env_size = old_ep->peak_env_size;
880   new_ep->samps_per_bin = old_ep->samps_per_bin;
881 
882   end = beg + num - 1;
883   start = beg - new_ep->samps_per_bin;
884   for (i = 0, j = 0, cursamp = 0; (i < new_ep->peak_env_size) && (cursamp < end); i++, cursamp += new_ep->samps_per_bin)
885     {
886       if (cursamp > start)
887 	{
888 	  /* if segment is entirely in region, just copy it */
889 	  if ((cursamp >= beg) && ((cursamp + new_ep->samps_per_bin) <= end))
890 	    {
891 	      new_ep->data_max[j] = old_ep->data_max[i];
892 	      new_ep->data_min[j] = old_ep->data_min[i];
893 	    }
894 	  else pick_one_bin(new_ep, j, cursamp, cp, edpos);
895 	  if (fmin > new_ep->data_min[j]) fmin = new_ep->data_min[j];
896 	  if (fmax < new_ep->data_max[j]) fmax = new_ep->data_max[j];
897 	  j++;
898 	}
899       new_ep->fmin = fmin;
900       new_ep->fmax = fmax;
901       new_ep->completed = true;
902       new_ep->bin = old_ep->bin;
903       new_ep->top_bin = old_ep->top_bin;
904     }
905   return(new_ep);
906 }
907 
908 
copy_peak_env_info(peak_env_info * old_ep,bool reversed)909 peak_env_info *copy_peak_env_info(peak_env_info *old_ep, bool reversed)
910 {
911   peak_env_info *new_ep = NULL;
912   if ((old_ep) &&
913       (old_ep->completed))
914     {
915       new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
916       new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
917       new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
918       new_ep->peak_env_size = old_ep->peak_env_size;
919       new_ep->samps_per_bin = old_ep->samps_per_bin;
920       new_ep->fmin = old_ep->fmin;
921       new_ep->fmax = old_ep->fmax;
922 
923       if (reversed)
924 	{
925 	  int i, j;
926 	  for (i = 0, j = new_ep->peak_env_size - 1; i < new_ep->peak_env_size; i++, j--)
927 	    {
928 	      new_ep->data_min[j] = old_ep->data_min[i];
929 	      new_ep->data_max[j] = old_ep->data_max[i];
930 	    }
931 	}
932       else
933 	{
934 	  mus_copy_floats(new_ep->data_min, old_ep->data_min, new_ep->peak_env_size);
935 	  mus_copy_floats(new_ep->data_max, old_ep->data_max, new_ep->peak_env_size);
936 	}
937 
938       new_ep->completed = true;
939       new_ep->bin = old_ep->bin;
940       new_ep->top_bin = old_ep->top_bin;
941     }
942   return(new_ep);
943 }
944 
945 
peak_env_copy(chan_info * cp,bool reversed,int edpos)946 peak_env_info *peak_env_copy(chan_info *cp, bool reversed, int edpos)
947 {
948   return(copy_peak_env_info(cp->edits[edpos]->peak_env, reversed));
949 }
950 
951 
amp_env_env(chan_info * cp,mus_float_t * brkpts,int npts,int pos,mus_float_t base,mus_float_t scaler,mus_float_t offset)952 void amp_env_env(chan_info *cp, mus_float_t *brkpts, int npts, int pos, mus_float_t base, mus_float_t scaler, mus_float_t offset)
953 {
954   peak_env_info *old_ep;
955   old_ep = cp->edits[pos]->peak_env;
956   if ((old_ep) && (old_ep->completed))
957     {
958       int i;
959       mus_any *e;
960       mus_float_t fmin, fmax;
961       peak_env_info *new_ep;
962 
963       new_ep = cp->edits[cp->edit_ctr]->peak_env;
964       if ((new_ep) &&
965 	  (new_ep->peak_env_size != old_ep->peak_env_size))
966 	new_ep = free_peak_env(cp, cp->edit_ctr);
967 
968       if (!new_ep)
969 	{
970 	  new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
971 	  new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
972 	  new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
973 	}
974 
975       new_ep->peak_env_size = old_ep->peak_env_size;
976       new_ep->samps_per_bin = old_ep->samps_per_bin;
977       if (base == 1.0)
978 	e = mus_make_env(brkpts, npts, scaler, offset, base, 0.0, new_ep->peak_env_size - 1, brkpts);
979       else e = mus_make_env(brkpts, npts, 1.0, 0.0, base, 0.0, new_ep->peak_env_size - 1, brkpts);
980       fmin = MIN_INIT;
981       fmax = MAX_INIT;
982 
983       for (i = 0; i < new_ep->peak_env_size; i++)
984 	{
985 	  mus_float_t val;
986 	  val = mus_env(e);
987 	  if (val >= 0.0)
988 	    {
989 	      new_ep->data_min[i] = old_ep->data_min[i] * val;
990 	      new_ep->data_max[i] = old_ep->data_max[i] * val;
991 	    }
992 	  else
993 	    {
994 	      new_ep->data_min[i] = old_ep->data_max[i] * val;
995 	      new_ep->data_max[i] = old_ep->data_min[i] * val;
996 	    }
997 	  if (new_ep->data_min[i] < fmin) fmin = new_ep->data_min[i];
998 	  if (new_ep->data_max[i] > fmax) fmax = new_ep->data_max[i];
999 	}
1000 
1001       new_ep->fmin = fmin;
1002       new_ep->fmax = fmax;
1003       new_ep->completed = true;
1004       new_ep->bin = old_ep->bin;
1005       new_ep->top_bin = old_ep->top_bin;
1006       cp->edits[cp->edit_ctr]->peak_env = new_ep;
1007       mus_free(e);
1008     }
1009 }
1010 
1011 
amp_env_env_selection_by(chan_info * cp,mus_any * e,mus_long_t beg,mus_long_t num,int pos)1012 void amp_env_env_selection_by(chan_info *cp, mus_any *e, mus_long_t beg, mus_long_t num, int pos)
1013 {
1014   peak_env_info *old_ep;
1015   old_ep = cp->edits[pos]->peak_env;
1016   if ((old_ep) && (old_ep->completed))
1017     {
1018       mus_float_t xmax = 1.0;
1019       mus_float_t *data;
1020       mus_float_t fmax = MAX_INIT, fmin = MIN_INIT;
1021       int i;
1022       mus_long_t cursamp, start, end;
1023       peak_env_info *new_ep;
1024 
1025       new_ep = cp->edits[cp->edit_ctr]->peak_env;
1026       if ((new_ep) &&
1027 	  (new_ep->peak_env_size != old_ep->peak_env_size))
1028 	new_ep = free_peak_env(cp, cp->edit_ctr);
1029 
1030       if (!new_ep)
1031 	{
1032 	  new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
1033 	  new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
1034 	  new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
1035 	}
1036 
1037       new_ep->peak_env_size = old_ep->peak_env_size;
1038       new_ep->samps_per_bin = old_ep->samps_per_bin;
1039       end = beg + num - 1;
1040       start = beg - new_ep->samps_per_bin;
1041       data = mus_data(e);
1042       xmax = data[mus_env_breakpoints(e) * 2 - 2];
1043 
1044       for (i = 0, cursamp = 0; i < new_ep->peak_env_size; i++, cursamp += new_ep->samps_per_bin)
1045 	{
1046 	  if ((cursamp >= end) || (cursamp <= start))
1047 	    {
1048 	      new_ep->data_min[i] = old_ep->data_min[i];
1049 	      new_ep->data_max[i] = old_ep->data_max[i];
1050 	    }
1051 	  else
1052 	    {
1053 	      /* if segment is entirely in scaled section, just scale it */
1054 	      if ((cursamp >= beg) && ((cursamp + new_ep->samps_per_bin) <= end))
1055 		{
1056 		  mus_float_t val;
1057 		  val = mus_env_interp((double)(cursamp - beg) * xmax / (double)num, e);
1058 		  if (val >= 0.0)
1059 		    {
1060 		      new_ep->data_max[i] = old_ep->data_max[i] * val;
1061 		      new_ep->data_min[i] = old_ep->data_min[i] * val;
1062 		    }
1063 		  else
1064 		    {
1065 		      new_ep->data_max[i] = old_ep->data_min[i] * val;
1066 		      new_ep->data_min[i] = old_ep->data_max[i] * val;
1067 		    }
1068 
1069 		}
1070 	      else pick_one_bin(new_ep, i, cursamp, cp, cp->edit_ctr);
1071 	    }
1072 	  if (fmin > new_ep->data_min[i]) fmin = new_ep->data_min[i];
1073 	  if (fmax < new_ep->data_max[i]) fmax = new_ep->data_max[i];
1074 	}
1075 
1076       new_ep->fmin = fmin;
1077       new_ep->fmax = fmax;
1078       new_ep->completed = true;
1079       new_ep->bin = old_ep->bin;
1080       new_ep->top_bin = old_ep->top_bin;
1081       cp->edits[cp->edit_ctr]->peak_env = new_ep;
1082     }
1083 }
1084 
1085 
peak_env_insert_zeros(chan_info * cp,mus_long_t beg,mus_long_t num,int pos)1086 void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int pos)
1087 {
1088   peak_env_info *old_ep;
1089   old_ep = cp->edits[pos]->peak_env;
1090   if ((old_ep) && (old_ep->completed))
1091     {
1092       mus_long_t end, old_samps, cur_samps;
1093       int i, j, subsamp, val, bins;
1094       peak_env_info *new_ep;
1095 
1096       new_ep = cp->edits[cp->edit_ctr]->peak_env;
1097       if (new_ep) new_ep = free_peak_env(cp, cp->edit_ctr);
1098 
1099       old_samps = cp->edits[pos]->samples;
1100       cur_samps = current_samples(cp);
1101       val = (int)(log((double)(cur_samps)));
1102       if (val > 20) val = 20;
1103       val = snd_int_pow2(val);
1104       subsamp = val / old_ep->peak_env_size;
1105       if (subsamp != 1) return;
1106 
1107       new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
1108       new_ep->samps_per_bin = old_ep->samps_per_bin;
1109       new_ep->peak_env_size = (int)(ceil(cur_samps / new_ep->samps_per_bin));
1110       new_ep->completed = true;
1111       cp->edits[cp->edit_ctr]->peak_env = new_ep;
1112       new_ep->bin = new_ep->peak_env_size;
1113       new_ep->top_bin = new_ep->peak_env_size;
1114       new_ep->data_max = (mus_float_t *)calloc(new_ep->peak_env_size, sizeof(mus_float_t));
1115       new_ep->data_min = (mus_float_t *)calloc(new_ep->peak_env_size, sizeof(mus_float_t));
1116       new_ep->fmin = old_ep->fmin;
1117       if (new_ep->fmin > 0.0) new_ep->fmin = 0.0;
1118       new_ep->fmax = old_ep->fmax;
1119       if (new_ep->fmax < 0.0) new_ep->fmax = 0.0;
1120       end = beg + num - 1;
1121 
1122       if (beg == 0)
1123 	{
1124 	  /* insert at start, so copy to end */
1125 	  i = (int)ceil(end / new_ep->samps_per_bin);
1126 	  bins = new_ep->peak_env_size - i;
1127 	  if (old_ep->peak_env_size < bins) bins = old_ep->peak_env_size;
1128 	  mus_copy_floats(&(new_ep->data_min[i]), old_ep->data_min, bins);
1129 	  mus_copy_floats(&(new_ep->data_max[i]), old_ep->data_max, bins);
1130 	}
1131       else
1132 	{
1133 	  if (beg >= old_samps)
1134 	    {
1135 	      /* copy start */
1136 	      bins = (int)floor(beg / old_ep->samps_per_bin);
1137 	      if (bins > old_ep->peak_env_size) bins = old_ep->peak_env_size;
1138 	      mus_copy_floats(new_ep->data_min, old_ep->data_min, bins);
1139 	      mus_copy_floats(new_ep->data_max, old_ep->data_max, bins);
1140 	    }
1141 	  else
1142 	    {
1143 	      i = (int)floor(beg / old_ep->samps_per_bin);
1144 	      if (i > 0)
1145 		{
1146 		  mus_copy_floats(new_ep->data_min, old_ep->data_min, i);
1147 		  mus_copy_floats(new_ep->data_max, old_ep->data_max, i);
1148 		}
1149 	      if (i < new_ep->peak_env_size)
1150 		{
1151 		  pick_one_bin(new_ep, i, i * old_ep->samps_per_bin, cp, cp->edit_ctr);
1152 		  i++;
1153 		}
1154 	      j = (int)floor(end / new_ep->samps_per_bin);
1155 	      if (j < new_ep->peak_env_size)
1156 		{
1157 		  pick_one_bin(new_ep, j, j * new_ep->samps_per_bin, cp, cp->edit_ctr);
1158 		  j++;
1159 		}
1160 	      if (i < old_ep->peak_env_size)
1161 		{
1162 		  bins = new_ep->peak_env_size - j;
1163 		  if ((i + bins) >= old_ep->peak_env_size)
1164 		    bins = old_ep->peak_env_size - i;
1165 		  mus_copy_floats(&(new_ep->data_min[j]), &(old_ep->data_min[i]), bins);
1166 		  mus_copy_floats(&(new_ep->data_max[j]), &(old_ep->data_max[i]), bins);
1167 		}
1168 	    }
1169 	}
1170     }
1171 }
1172 
1173 
1174 #if XEN_HAVE_RATIOS
snd_rationalize(mus_float_t a,int * num,int * den)1175 void snd_rationalize(mus_float_t a, int *num, int *den)
1176 {
1177   Xen ratio;
1178   int gloc;
1179   ratio = Xen_rationalize(C_double_to_Xen_real(a), C_double_to_Xen_real(a * .04)); /* was .02 until 13-Dec-07 but that gives too many useless choices */
1180   gloc = snd_protect(ratio);
1181   (*num) = (int)Xen_numerator(ratio);
1182   (*den) = (int)Xen_denominator(ratio);
1183   snd_unprotect_at(gloc);
1184 }
1185 #endif
1186 
1187 
1188 /* -------- control panel speed -------- */
1189 
1190 #if (!XEN_HAVE_RATIOS)
1191 #define TOTAL_RATS 123
1192 
1193 static const char *rat_names[TOTAL_RATS] = {
1194   "1/20", "5/96", "7/128", "15/256", "31/512", "1/16", "1/15", "5/72", "9/128", "3/40", "5/64", "1/12", "11/128", "3/32", "1/10", "5/48", "7/64", "15/128", "31/256", "1/8", "2/15", "5/36", "9/64", "3/20", "5/32", "1/6", "11/64", "3/16", "1/5", "5/24", "7/32", "15/64", "31/128", "1/4", "4/15", "5/18", "9/32", "3/10", "5/16", "1/3", "11/32", "3/8", "2/5", "5/12", "7/16", "15/32", "31/64", "1/2", "8/15", "5/9", "9/16", "3/5", "5/8", "2/3", "11/16", "3/4", "4/5", "5/6", "7/8", "15/16", "31/32", "1/1", "16/15", "10/9", "9/8", "6/5", "5/4", "4/3", "11/8", "3/2", "8/5", "5/3", "7/4", "15/8", "31/16", "2/1", "32/15", "20/9", "9/4", "12/5", "5/2", "8/3", "11/4", "3/1", "16/5", "10/3", "7/2", "15/4", "31/8", "4/1", "64/15", "40/9", "9/2", "24/5", "5/1", "16/3", "11/2", "6/1", "32/5", "20/3", "7/1", "15/2", "31/4", "8/1", "128/15", "80/9", "9/1", "48/5", "10/1", "32/3", "11/1", "12/1", "64/5", "40/3", "14/1", "15/1", "31/2", "16/1", "256/15", "160/9", "18/1", "96/5", "20/1"};
1195 
1196 static mus_float_t rat_values[TOTAL_RATS] = {
1197   0.050, 0.052, 0.055, 0.059, 0.061, 0.063, 0.067, 0.069, 0.070, 0.075, 0.078, 0.083, 0.086, 0.094, 0.100, 0.104, 0.109, 0.117, 0.121, 0.125, 0.133, 0.139, 0.141, 0.150, 0.156, 0.167, 0.172, 0.188, 0.200, 0.208, 0.219, 0.234, 0.242, 0.250, 0.267, 0.278, 0.281, 0.300, 0.313, 0.333, 0.344, 0.375, 0.400, 0.417, 0.438, 0.469, 0.484, 0.500, 0.533, 0.556, 0.563, 0.600, 0.625, 0.667, 0.688, 0.750, 0.800, 0.833, 0.875, 0.938, 0.969, 1.000, 1.067, 1.111, 1.125, 1.200, 1.250, 1.333, 1.375, 1.500, 1.600, 1.667, 1.750, 1.875, 1.938, 2.000, 2.133, 2.222, 2.250, 2.400, 2.500, 2.667, 2.750, 3.000, 3.200, 3.333, 3.500, 3.750, 3.875, 4.000, 4.267, 4.444, 4.500, 4.800, 5.000, 5.333, 5.500, 6.000, 6.400, 6.667, 7.000, 7.500, 7.750, 8.000, 8.533, 8.889, 9.000, 9.600, 10.000, 10.667, 11.000, 12.000, 12.800, 13.333, 14.000, 15.000, 15.500, 16.000, 17.067, 17.778, 18.000, 19.200, 20.000};
1198 #endif
1199 
1200 
speed_changed(mus_float_t val,char * srcbuf,speed_style_t style,int tones,int srcbuf_size)1201 mus_float_t speed_changed(mus_float_t val, char *srcbuf, speed_style_t style, int tones, int srcbuf_size)
1202 {
1203   char numbuf[16];
1204   int semi, i, j;
1205   switch (style)
1206     {
1207     case SPEED_CONTROL_AS_RATIO:
1208 #if XEN_HAVE_RATIOS
1209       {
1210 	int num, den;
1211 	snd_rationalize(val, &num, &den);
1212 	snprintf(srcbuf, srcbuf_size, "%d/%d", num, den);
1213 	return((mus_float_t)num / (mus_float_t)den);
1214       }
1215 #else
1216       for (i = 1; i < TOTAL_RATS; i++)
1217 	if (rat_values[i] > val)
1218 	  break;
1219       if ((rat_values[i] - val) < (val - rat_values[i - 1]))
1220 	{
1221 	  snprintf(srcbuf, srcbuf_size, "%s", rat_names[i]);
1222 	  return(rat_values[i]);
1223 	}
1224       else
1225 	{
1226 	  snprintf(srcbuf, srcbuf_size, "%s", rat_names[i - 1]);
1227 	  return(rat_values[i - 1]);
1228 	}
1229 #endif
1230       break;
1231 
1232     case SPEED_CONTROL_AS_SEMITONE:
1233       /* find closest semitone to val */
1234       semi = snd_round(log(val) * ((mus_float_t)tones / log(2.0)));
1235       /* space until (-) num (-52 to 52 is its range if 12-tone) */
1236       for (i = 0; i < srcbuf_size; i++) srcbuf[i] = ' ';
1237       snprintf(numbuf, 16, "%d", semi);
1238       j = strlen(numbuf) - 1;
1239       for (i = 3; (i >= 0) && (j >= 0); i--, j--)
1240 	srcbuf[i] = numbuf[j];
1241       srcbuf[srcbuf_size - 1] = 0;
1242       return(pow(2.0, ((mus_float_t)semi / (mus_float_t)tones)));
1243 
1244     default:
1245       snprintf(srcbuf, srcbuf_size, "%.3f", val);
1246       return(val);
1247     }
1248 }
1249 
1250 
1251 /* -------- name click etc */
1252 
1253 static char sname[PRINT_BUFFER_SIZE];
1254 
shortname(snd_info * sp)1255 char *shortname(snd_info *sp)
1256 {
1257   if (is_link_file(sp->filename))
1258     {
1259       snprintf(sname, PRINT_BUFFER_SIZE, "(%s)", sp->short_filename);
1260       return(sname);
1261     }
1262   return(sp->short_filename);
1263 }
1264 
1265 
shortname_indexed(snd_info * sp)1266 char *shortname_indexed(snd_info *sp)
1267 {
1268   if (show_indices(ss))
1269     {
1270       if (is_link_file(sp->filename))
1271 	snprintf(sname, PRINT_BUFFER_SIZE, "%d: (%s)", sp->index, sp->short_filename); /* don't try to share sname */
1272       else snprintf(sname, PRINT_BUFFER_SIZE, "%d: %s", sp->index, sp->short_filename);
1273       return(sname);
1274     }
1275   return(shortname(sp));
1276 }
1277 
1278 
add_sound_data(char * filename,snd_info * sp,channel_graph_t graphed)1279 void add_sound_data(char *filename, snd_info *sp, channel_graph_t graphed)
1280 {
1281   uint32_t i;
1282   for (i = 0; i < sp->nchans; i++)
1283     add_channel_data(filename, sp->chans[i], graphed);
1284 }
1285 
1286 
1287 #ifndef _MSC_VER
linked_file(const char * link_name)1288 static char *linked_file(const char *link_name)
1289 {
1290   char *link_file;
1291   ssize_t bytes;
1292   #define READLINK_FILE_SIZE 256
1293   link_file = (char *)calloc(READLINK_FILE_SIZE, sizeof(char));
1294   bytes = readlink(link_name, link_file, READLINK_FILE_SIZE);
1295   link_file[bytes] = 0;
1296   return(link_file);
1297 }
1298 #endif
1299 
1300 
1301 static Xen name_click_hook;
1302 
sp_name_click(snd_info * sp)1303 char *sp_name_click(snd_info *sp) /* caller should free returned string */
1304 {
1305   if (sp)
1306     {
1307       file_info *hdr;
1308 
1309       /* call name-click-hook (if any) return #t = don't print info in the status area */
1310       if ((Xen_hook_has_list(name_click_hook)) &&
1311 	  (Xen_is_true(run_or_hook(name_click_hook,
1312 				  Xen_list_1(C_int_to_Xen_sound(sp->index)),
1313 				  S_name_click_hook))))
1314 	return(NULL);
1315 
1316       hdr = sp->hdr;
1317       if (hdr)
1318 	{
1319 	  mus_float_t dur;
1320 	  char *result, *str = NULL;
1321 
1322 	  bool linked;
1323 	  linked = is_link_file(sp->filename);
1324 	  dur = (mus_float_t)((double)(hdr->samples) / (double)(hdr->chans * hdr->srate));
1325 	  result = mus_format("%d, %d chan%s, %.3f sec%s, %s: %s, %s%s%s%s",
1326 			       hdr->srate,
1327 			       hdr->chans,
1328 			       ((hdr->chans > 1) ? "s" : ""),
1329 			       dur,
1330 			       ((dur == 1.0) ? "" : "s"),
1331 			       mus_header_type_to_string(hdr->type),
1332 			       mus_sample_type_to_string(hdr->sample_type),
1333 			       snd_strftime("%d-%b-%Y %H:%M", sp->write_date),
1334 			       (linked) ? ", (link to " : "",
1335 #ifndef _MSC_VER
1336 			       (linked) ? str = linked_file(sp->filename) : "",
1337 #else
1338 			       (linked) ? "?" : "",
1339 #endif
1340 			       (linked) ? ")" : "");
1341 	  if (str) free(str);
1342 	  return(result);
1343 	}
1344     }
1345   return(NULL);
1346 }
1347 
1348 
1349 
1350 /* ---------------- save and restore control panel buttons ----------------*/
1351 
1352 typedef struct ctrl_state {
1353   mus_float_t amp, speed, contrast, expand, revscl, revlen;
1354   env *filter_env;
1355   bool expand_on, contrast_on, reverb_on, filter_on, reversed;
1356   int filter_order;
1357   mus_float_t contrast_amp, expand_ramp, expand_length, expand_hop, expand_jitter, reverb_feedback, reverb_decay, reverb_lowpass;
1358 } ctrl_state;
1359 
1360 
free_control_settings(ctrl_state * cs)1361 static ctrl_state *free_control_settings(ctrl_state *cs)
1362 {
1363   if (cs)
1364     {
1365       if (cs->filter_env) free_env(cs->filter_env);
1366       free(cs);
1367     }
1368   return(NULL);
1369 }
1370 
1371 
free_controls(snd_info * sp)1372 void free_controls(snd_info *sp)
1373 {
1374   sp->saved_controls = free_control_settings(sp->saved_controls);
1375 }
1376 
1377 
current_control_settings(snd_info * sp,ctrl_state * cs)1378 static ctrl_state *current_control_settings(snd_info *sp, ctrl_state *cs)
1379 {
1380   if (!cs) cs = (ctrl_state *)calloc(1, sizeof(ctrl_state));
1381   cs->amp = sp->amp_control;
1382   cs->speed = sp->speed_control;
1383   cs->expand = sp->expand_control;
1384   cs->revscl = sp->reverb_control_scale;
1385   cs->revlen = sp->reverb_control_length;
1386   cs->contrast = sp->contrast_control;
1387   cs->expand_on = sp->expand_control_on;
1388   cs->reverb_on = sp->reverb_control_on;
1389   cs->contrast_on = sp->contrast_control_on;
1390   cs->filter_on = sp->filter_control_on;
1391   cs->filter_order = sp->filter_control_order;
1392   if (sp->filter_control_envelope)
1393     {
1394       if (cs->filter_env) cs->filter_env = free_env(cs->filter_env);
1395       cs->filter_env = copy_env(sp->filter_control_envelope);
1396     }
1397   if (sp->speed_control_direction == 1)
1398     cs->reversed = false;
1399   else cs->reversed = true;
1400 
1401   cs->contrast_amp = sp->contrast_control_amp;
1402   cs->expand_ramp = sp->expand_control_ramp;
1403   cs->expand_hop = sp->expand_control_hop;
1404   cs->expand_jitter = sp->expand_control_jitter;
1405   cs->expand_length = sp->expand_control_length;
1406   cs->reverb_feedback = sp->reverb_control_feedback;
1407   cs->reverb_decay = sp->reverb_control_decay;
1408   cs->reverb_lowpass = sp->reverb_control_lowpass;
1409   return(cs);
1410 }
1411 
1412 
save_controls(snd_info * sp)1413 void save_controls(snd_info *sp)
1414 {
1415   sp->saved_controls = current_control_settings(sp, sp->saved_controls);
1416 }
1417 
1418 
restore_control_settings(snd_info * sp,ctrl_state * cs)1419 static ctrl_state *restore_control_settings(snd_info *sp, ctrl_state *cs)
1420 {
1421   /* for use in controls->channel when the actual control panel is not in use */
1422   if (cs)
1423     {
1424       sp->amp_control = cs->amp;
1425       sp->speed_control = cs->speed;
1426       sp->expand_control = cs->expand;
1427       sp->reverb_control_scale = cs->revscl;
1428       sp->reverb_control_length = cs->revlen;
1429       sp->contrast_control = cs->contrast;
1430       sp->expand_control_on = cs->expand_on;
1431       sp->reverb_control_on = cs->reverb_on;
1432       sp->contrast_control_on = cs->contrast_on;
1433       sp->filter_control_on = cs->filter_on;
1434       sp->filter_control_order = cs->filter_order;
1435       if (cs->filter_env)
1436 	{
1437 	  sp->filter_control_envelope = free_env(sp->filter_control_envelope);
1438 	  sp->filter_control_envelope = copy_env(cs->filter_env);
1439 	}
1440       if (cs->reversed)
1441 	sp->speed_control_direction = -1;
1442       else sp->speed_control_direction = 1;
1443       sp->contrast_control_amp = cs->contrast_amp;
1444       sp->expand_control_ramp = cs->expand_ramp;
1445       sp->expand_control_hop = cs->expand_hop;
1446       sp->expand_control_jitter = cs->expand_jitter;
1447       sp->expand_control_length = cs->expand_length;
1448       sp->reverb_control_feedback = cs->reverb_feedback;
1449       sp->reverb_control_decay = cs->reverb_decay;
1450       sp->reverb_control_lowpass = cs->reverb_lowpass;
1451     }
1452   return(cs);
1453 }
1454 
1455 
restore_controls(snd_info * sp)1456 void restore_controls(snd_info *sp)
1457 {
1458   ctrl_state *cs;
1459   char *tmpstr;
1460   cs = sp->saved_controls;
1461   if (!cs)
1462     {
1463       sp->saved_controls = (ctrl_state *)calloc(1, sizeof(ctrl_state));
1464       cs = sp->saved_controls;
1465       cs->amp = DEFAULT_AMP_CONTROL;
1466       cs->speed = DEFAULT_SPEED_CONTROL;
1467       cs->reversed = false; /* (this is the button's view) */
1468       cs->expand = DEFAULT_EXPAND_CONTROL;
1469       cs->expand_on = DEFAULT_EXPAND_CONTROL_ON;
1470       cs->revscl = DEFAULT_REVERB_CONTROL_SCALE;
1471       cs->revlen = DEFAULT_REVERB_CONTROL_LENGTH;
1472       cs->reverb_on = DEFAULT_REVERB_CONTROL_ON;
1473       cs->contrast = DEFAULT_CONTRAST_CONTROL;
1474       cs->contrast_on = DEFAULT_CONTRAST_CONTROL_ON;
1475       cs->filter_on = DEFAULT_FILTER_CONTROL_ON;
1476       cs->filter_order = filter_control_order(ss);
1477       cs->filter_env = NULL;
1478     }
1479   toggle_expand_button(sp, cs->expand_on);
1480   toggle_contrast_button(sp, cs->contrast_on);
1481   toggle_reverb_button(sp, cs->reverb_on);
1482   toggle_filter_button(sp, cs->filter_on);
1483   toggle_direction_arrow(sp, cs->reversed);
1484   set_amp(sp, cs->amp);
1485   set_speed(sp, cs->speed);
1486   set_contrast(sp, cs->contrast);
1487   set_expand(sp, cs->expand);
1488   set_revscl(sp, cs->revscl);
1489   set_revlen(sp, cs->revlen);
1490   if (sp->filter_control_envelope) sp->filter_control_envelope = free_env(sp->filter_control_envelope);
1491   if (cs->filter_env)
1492     sp->filter_control_envelope = copy_env(cs->filter_env);
1493   else sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
1494   set_filter_order(sp, cs->filter_order); /* causes redisplay */
1495   tmpstr = env_to_string(sp->filter_control_envelope);
1496   set_filter_text(sp, tmpstr);
1497   if (tmpstr) free(tmpstr);
1498 }
1499 
1500 
reset_controls(snd_info * sp)1501 void reset_controls(snd_info *sp)
1502 {
1503   char *tmpstr;
1504   toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_ON);
1505   toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_ON);
1506   toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_ON);
1507   toggle_filter_button(sp, DEFAULT_FILTER_CONTROL_ON);
1508   toggle_direction_arrow(sp, false);
1509   set_amp(sp, DEFAULT_AMP_CONTROL);
1510   set_speed(sp, DEFAULT_SPEED_CONTROL);
1511   set_contrast(sp, DEFAULT_CONTRAST_CONTROL);
1512   set_expand(sp, DEFAULT_EXPAND_CONTROL);
1513   set_revscl(sp, DEFAULT_REVERB_CONTROL_SCALE);
1514   set_revlen(sp, DEFAULT_REVERB_CONTROL_LENGTH);
1515   set_filter_order(sp, filter_control_order(ss));
1516   if (sp->filter_control_envelope) sp->filter_control_envelope = free_env(sp->filter_control_envelope);
1517   sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
1518   tmpstr = env_to_string(sp->filter_control_envelope);
1519   set_filter_text(sp, tmpstr);
1520   display_filter_env(sp);
1521   if (tmpstr) free(tmpstr);
1522 
1523 }
1524 
1525 
apply_unset_controls(snd_info * sp)1526 static void apply_unset_controls(snd_info *sp)
1527 {
1528   /* after apply_controls there's no need to clear everything! */
1529   toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_ON);
1530   toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_ON);
1531   toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_ON);
1532   toggle_filter_button(sp, DEFAULT_FILTER_CONTROL_ON);
1533   toggle_direction_arrow(sp, false);
1534   set_amp(sp, DEFAULT_AMP_CONTROL);
1535   set_speed(sp, DEFAULT_SPEED_CONTROL);
1536 }
1537 
1538 
set_show_controls(bool val)1539 void set_show_controls(bool val)
1540 {
1541   in_set_show_controls(ss, val);
1542 #if (!USE_NO_GUI)
1543   if (in_show_controls(ss))
1544     show_all_controls();
1545   else hide_all_controls();
1546 #endif
1547 }
1548 
1549 
1550 
1551 /* ---------------- control panel apply ---------------- */
1552 
stop_applying(snd_info * sp)1553 void stop_applying(snd_info *sp)
1554 {
1555   /* called if C-g during the apply process */
1556   sp->apply_ok = false;
1557 }
1558 
1559 typedef struct {
1560   int slice;
1561   snd_info *sp;
1562   mus_long_t i;
1563   int ofd;
1564   char *ofile;
1565   ctrl_state *cs;
1566   file_info *hdr;
1567   char *origin;
1568 } apply_state;
1569 
1570 
1571 static Xen after_apply_controls_hook;
1572 
make_apply_state(snd_info * sp)1573 static void *make_apply_state(snd_info *sp)
1574 {
1575   /* set up initial state for apply_controls */
1576   apply_state *ap;
1577   ap = (apply_state *)calloc(1, sizeof(apply_state));
1578   ap->slice = 0;
1579   ap->hdr = NULL;
1580   ap->sp = sp;
1581   return((void *)ap);
1582 }
1583 
1584 
free_apply_state(apply_state * ap)1585 static apply_state *free_apply_state(apply_state *ap)
1586 {
1587   if (ap)
1588     {
1589       if (ap->ofile) {free(ap->ofile); ap->ofile = NULL;}
1590       if (ap->origin) {free(ap->origin); ap->origin = NULL;}
1591       ap->hdr = free_file_info(ap->hdr);
1592       free(ap);
1593     }
1594   return(NULL);
1595 }
1596 
1597 
1598 static mus_long_t apply_dur = 0, orig_dur, apply_beg = 0;
1599 
apply_controls(apply_state * ap)1600 static bool apply_controls(apply_state *ap)
1601 {
1602   snd_info *sp;
1603   chan_info *cp = NULL;
1604   sync_info *si;
1605   mus_float_t mult_dur;
1606   int i, added_dur = 0;
1607 
1608   if (!ap) return(false);
1609   sp = ap->sp;
1610   if ((!(sp->active)) || (sp->inuse != SOUND_NORMAL)) return(false);
1611 
1612   if (sp->filter_control_on)
1613     added_dur = sp->filter_control_order;
1614   mult_dur = 1.0 / fabs(sp->speed_control);
1615   if (sp->expand_control_on)
1616     mult_dur *= sp->expand_control;
1617   if (sp->reverb_control_on)
1618     added_dur += (int)((snd_srate(sp) * sp->reverb_control_decay));
1619 
1620   if ((ss->apply_choice != APPLY_TO_SELECTION) &&
1621       (snd_feq(sp->speed_control, 1.0)) &&
1622       (apply_beg == 0) &&
1623       (sp->speed_control_direction == 1) &&
1624       (!(sp->filter_control_on)) && (!(sp->expand_control_on)) && (!(sp->reverb_control_on)) && (!(sp->contrast_control_on)))
1625     {
1626       int old_sync;
1627       bool need_scaling = false;
1628       mus_float_t *scalers = NULL;
1629 
1630       old_sync = sp->sync;
1631       /* get unused sync val */
1632       if (ss->apply_choice == APPLY_TO_SOUND)
1633 	{
1634 	  sp->sync = ss->sound_sync_max + 1;
1635 	  ss->sound_sync_max++;
1636 	}
1637       else sp->sync = 0;
1638 
1639       /* check for local amp_control vals */
1640       if (sp->selected_channel == NO_SELECTION)
1641 	cp = sp->chans[0];
1642       else cp = sp->chans[sp->selected_channel];
1643       si = sync_to_chan(cp);
1644       if (!si)
1645 	{
1646 	  sp->sync = old_sync;
1647 	  return(false);
1648 	}
1649 
1650       scalers = (mus_float_t *)calloc(si->chans, sizeof(mus_float_t));
1651       for (i = 0; i < si->chans; i++)
1652 	{
1653 	  chan_info *ncp;
1654 	  ncp = si->cps[i];
1655 	  if (ncp->amp_control)
1656 	    scalers[i] = ncp->amp_control[0];
1657 	  else scalers[i] = sp->amp_control;
1658 	  if (!(snd_feq(scalers[i], 1.0))) need_scaling = true; /* could possibly check all edit_ctrs, but this seems easier */
1659 	}
1660 
1661       if (need_scaling)
1662 	scale_by(cp, scalers, si->chans, false);
1663       else snd_warning_without_format("apply controls: no changes to apply!");
1664 
1665       sp->sync = old_sync;
1666       free(scalers);
1667       free_sync_info(si);
1668     }
1669   else
1670     {
1671       mus_long_t orig_apply_dur;
1672       io_error_t io_err = IO_NO_ERROR;
1673       int curchan = 0;
1674 
1675       orig_apply_dur = apply_dur;
1676 
1677       switch (ap->slice)
1678 	{
1679 	case 0:
1680 	  /* apply_beg = 0; */
1681 	  ap->ofile = NULL;
1682 	  ap->ofile = snd_tempnam();
1683 	  ap->hdr = make_temp_header(ap->ofile, snd_srate(sp), sp->nchans, 0, (char *)__func__);
1684 
1685 	  switch (ss->apply_choice)
1686 	    {
1687 	    case APPLY_TO_CHANNEL:
1688 	      ap->hdr->chans = 1;
1689 	      if (sp->selected_channel != NO_SELECTION)
1690 		curchan = sp->selected_channel;
1691 	      if (apply_dur == 0)
1692 		apply_dur = current_samples(sp->chans[curchan]) - apply_beg;
1693 	      break;
1694 
1695 	    case APPLY_TO_SOUND:
1696 	      ap->hdr->chans = sp->nchans;
1697 	      if (apply_dur == 0)
1698 		apply_dur = current_samples(sp->chans[0]) - apply_beg;
1699 	      break;
1700 
1701 	    case APPLY_TO_SELECTION:
1702 	      ap->hdr->chans = selection_chans();
1703 	      if (ap->hdr->chans <= 0) return(false);
1704 	      if (apply_dur == 0)
1705 		apply_dur = selection_len();
1706 	      break;
1707 	    }
1708 
1709 	  if (!ap->origin)
1710 	    {
1711 	      /* from apply-controls */
1712 	      /* to reproduce this on a channel-independent basis, we need to use controls->channel
1713 	       *   and conjure up a list of settings that match the current ones.
1714 	       */
1715 	      char *ampstr, *speedstr, *contraststr, *expandstr, *filterstr, *reverbstr;
1716 	      if (sp->amp_control != DEFAULT_AMP_CONTROL)
1717 		ampstr = mus_format("%.4f",
1718 				    sp->amp_control);
1719 	      else ampstr = mus_strdup(PROC_FALSE);
1720 	      if ((!(snd_feq(sp->speed_control, DEFAULT_SPEED_CONTROL))) ||
1721 		  (sp->speed_control_direction == -1))
1722 		speedstr = mus_format("%.4f",
1723 				      sp->speed_control * sp->speed_control_direction);
1724 	      else speedstr = mus_strdup(PROC_FALSE);
1725 	      if (sp->contrast_control_on)
1726 		contraststr = mus_format(LIST_OPEN "%.4f" PROC_SEP "%.4f" LIST_CLOSE,
1727 					 sp->contrast_control, sp->contrast_control_amp);
1728 	      else contraststr = mus_strdup(PROC_FALSE);
1729 	      if (sp->expand_control_on)
1730 		expandstr = mus_format(LIST_OPEN "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" LIST_CLOSE,
1731 				       sp->expand_control, sp->expand_control_length, sp->expand_control_ramp,
1732 				       sp->expand_control_hop, sp->expand_control_jitter);
1733 	      else expandstr = mus_strdup(PROC_FALSE);
1734 	      if (sp->reverb_control_on)
1735 		reverbstr = mus_format(LIST_OPEN "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" LIST_CLOSE,
1736 				       sp->reverb_control_scale, sp->reverb_control_length, sp->reverb_control_feedback,
1737 				       sp->reverb_control_lowpass, sp->reverb_control_decay);
1738 	      else reverbstr = mus_strdup(PROC_FALSE);
1739 	      if (sp->filter_control_on)
1740 		{
1741 		  char *envstr;
1742 		  envstr = env_to_string(sp->filter_control_envelope);
1743 		  filterstr = mus_format(LIST_OPEN "%d" PROC_SEP "%s" LIST_CLOSE,
1744 					 sp->filter_control_order, envstr);
1745 		  free(envstr);
1746 		}
1747 	      else filterstr = mus_strdup(PROC_FALSE);
1748 #if HAVE_FORTH
1749 	      if (orig_apply_dur == 0)
1750 	      ap->origin = mus_format(" '( %s %s %s %s %s %s ) %" print_mus_long PROC_SEP PROC_FALSE " %s",
1751 				      ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
1752 				      apply_beg, S_controls_to_channel);
1753 	      else ap->origin = mus_format(" '( %s %s %s %s %s %s ) %" print_mus_long PROC_SEP "%" print_mus_long " %s",
1754 					   ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
1755 					   apply_beg, apply_dur, S_controls_to_channel);
1756 #else
1757 	      if (orig_apply_dur == 0)
1758 	      ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE,
1759 				      to_proc_name(S_controls_to_channel),
1760 				      ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
1761 				      apply_beg);
1762 	      else ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long,
1763 					   to_proc_name(S_controls_to_channel),
1764 					   ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
1765 					   apply_beg, apply_dur);
1766 #endif
1767 	      free(ampstr);
1768 	      free(speedstr);
1769 	      free(contraststr);
1770 	      free(expandstr);
1771 	      free(reverbstr);
1772 	      free(filterstr);
1773 	    }
1774 
1775 	  orig_dur = apply_dur;
1776 	  apply_dur = (mus_long_t)(mult_dur * (apply_dur + added_dur));
1777 	  ap->ofd = open_temp_file(ap->ofile, ap->hdr->chans, ap->hdr, &io_err);
1778 
1779 	  if (ap->ofd == -1)
1780 	    {
1781 	      snd_error("%s apply temp file %s: %s\n",
1782 			(io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
1783 			ap->ofile,
1784 			snd_open_strerror());
1785 	      sp->applying = false;
1786 	      free_apply_state(ap);
1787 	      return(false);
1788 	    }
1789 
1790 	  sp->apply_ok = true;
1791 	  initialize_apply(sp, ap->hdr->chans, apply_beg, orig_dur + added_dur); /* dur here is input dur */
1792 	  ap->i = 0;
1793 	  ap->slice++;
1794 	  return(true);
1795 
1796 	case 1:
1797 	  if (!(sp->apply_ok))
1798 	    ap->slice++;
1799 	  else
1800 	    {
1801 	      int len;
1802 	      len = run_apply(ap->ofd); /* returns framples written (an int) */
1803 	      if (len <= 0)
1804 		{
1805 		  ap->slice++;
1806 		  return(true);
1807 		}
1808 	      ap->i += len;
1809 	      if (ap->i >= apply_dur) ap->slice++;
1810 	      /* check_for_event(); */
1811 	      /* if C-G, stop_applying called which cancels and backs out */
1812 	      if ((ss->stopped_explicitly) || (!(sp->active)))
1813 		ap->slice++;
1814 	    }
1815 	  return(true);
1816 
1817 	case 2:
1818 	  finalize_apply(sp);
1819 	  close_temp_file(ap->ofile,
1820 			  ap->ofd,
1821 			  ap->hdr->type,
1822 			  apply_dur * (ap->hdr->chans) * mus_bytes_per_sample((ap->hdr)->sample_type));
1823 	  if ((sp->apply_ok) && (apply_dur > 0))
1824 	    {
1825 	      switch (ss->apply_choice)
1826 		{
1827 		case APPLY_TO_SOUND:
1828 		  if (sp->nchans > 1)
1829 		    remember_temp(ap->ofile, sp->nchans);
1830 		  if (apply_beg > 0)
1831 		    {
1832 		      for (i = 0; i < (int)sp->nchans; i++)
1833 			{
1834 			  if (file_change_samples(apply_beg, apply_dur, ap->ofile, sp->chans[i], i,
1835 						  (sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
1836 						  ap->origin, sp->chans[i]->edit_ctr))
1837 			    update_graph(sp->chans[i]);
1838 			}
1839 		    }
1840 		  else
1841 		    {
1842 		      for (i = 0; i < (int)sp->nchans; i++)
1843 			{
1844 			  if (file_override_samples(apply_dur, ap->ofile, sp->chans[i], i,
1845 						    (sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
1846 						    ap->origin))
1847 			    update_graph(sp->chans[i]);
1848 			}
1849 		    }
1850 		  break;
1851 
1852 		case APPLY_TO_CHANNEL:
1853 		  if (sp->selected_channel != NO_SELECTION)
1854 		    curchan = sp->selected_channel;
1855 		  if (apply_beg > 0)
1856 		    file_change_samples(apply_beg, apply_dur, ap->ofile, sp->chans[curchan], 0,
1857 					DELETE_ME, ap->origin, sp->chans[curchan]->edit_ctr);
1858 		  else file_override_samples(apply_dur, ap->ofile, sp->chans[curchan], 0,
1859 					     DELETE_ME, ap->origin);
1860 		  update_graph(sp->chans[curchan]);
1861 		  break;
1862 
1863 		case APPLY_TO_SELECTION:
1864 		  if (selection_chans() > 1)
1865 		    remember_temp(ap->ofile, selection_chans());
1866 		  si = selection_sync();
1867 		  if (apply_dur == selection_len())
1868 		    {
1869 		      for (i = 0; i < si->chans; i++)
1870 			{
1871 			  if (file_change_samples(si->begs[i], apply_dur, ap->ofile, si->cps[i], i,
1872 						  (si->chans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
1873 						  ap->origin, si->cps[i]->edit_ctr))
1874 			    update_graph(si->cps[i]);
1875 			}
1876 		    }
1877 		  else
1878 		    {
1879 		      bool ok;
1880 		      ok = delete_selection(DONT_UPDATE_DISPLAY);
1881 		      if (apply_dur > 0)
1882 			{
1883 			  for (i = 0; i < si->chans; i++)
1884 			    {
1885 			      file_insert_samples(si->begs[i], apply_dur, ap->ofile, si->cps[i], 0,
1886 						  (si->chans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
1887 						  ap->origin, si->cps[i]->edit_ctr);
1888 			      reactivate_selection(si->cps[i], si->begs[i], si->begs[i] + apply_dur);
1889 			      if (ok) backup_edit_list(si->cps[i]);
1890 			    }
1891 			}
1892 		    }
1893 		  free_sync_info(si);
1894 		  break;
1895 		}
1896 	      clear_status_area(sp);
1897 	      sp->apply_ok = false;
1898 
1899 	      if ((sp->expand_control_on) ||
1900 		  (sp->speed_control_direction != 1) || (!(snd_feq(sp->speed_control, 1.0))))
1901 		{
1902 		  for (i = 0; i < (int)sp->nchans; i++)
1903 		    {
1904 		      cp = sp->chans[i];
1905 		      if (cp->edits[cp->edit_ctr]->marks)
1906 			{
1907 			  mus_float_t ratio;
1908 			  if (!(sp->expand_control_on))
1909 			    ratio = sp->speed_control;
1910 			  else ratio = sp->speed_control / sp->expand_control;
1911 			  if (ratio != 1.0)
1912 			    {
1913 			      bool over_selection;
1914 			      over_selection = (ss->apply_choice == APPLY_TO_SELECTION);
1915 			      src_marks(cp, ratio, orig_dur, apply_dur,
1916 					(over_selection) ? selection_beg(cp) : 0,
1917 					over_selection);
1918 			      update_graph(cp);
1919 			    }
1920 			}
1921 		    }
1922 		}
1923 	    }
1924 	  else
1925 	    {
1926 	      snd_remove(ap->ofile, REMOVE_FROM_CACHE);
1927 	    }
1928 	  break;
1929 	}
1930     }
1931 
1932   apply_unset_controls(sp);
1933 
1934   if (Xen_hook_has_list(after_apply_controls_hook))
1935     run_hook(after_apply_controls_hook,
1936 	     Xen_list_1(C_int_to_Xen_sound(sp->index)),
1937 	     S_after_apply_controls_hook);
1938 
1939   sp->applying = false;
1940   free_apply_state(ap);
1941   ss->stopped_explicitly = false;
1942   return(false);
1943 }
1944 
1945 
expand_control_set_hop(mus_float_t hop)1946 void expand_control_set_hop(mus_float_t hop)
1947 {
1948   int i;
1949   in_set_expand_control_hop(ss, hop);
1950   for (i = 0; i < ss->max_sounds; i++)
1951     {
1952       snd_info *sp;
1953       sp = ss->sounds[i];
1954       if ((sp) &&
1955 	  (sp->inuse == SOUND_NORMAL))
1956 	{
1957 	  sp->expand_control_hop = expand_control_hop(ss);
1958 	  if (sp->playing) dac_set_expand_hop(sp, expand_control_hop(ss));
1959 	}
1960     }
1961 }
1962 
expand_control_set_length(mus_float_t hop)1963 void expand_control_set_length(mus_float_t hop)
1964 {
1965   int i;
1966   in_set_expand_control_length(ss, hop);
1967   for (i = 0; i < ss->max_sounds; i++)
1968     {
1969       snd_info *sp;
1970       sp = ss->sounds[i];
1971       if ((sp) &&
1972 	  (sp->inuse == SOUND_NORMAL))
1973 	{
1974 	  sp->expand_control_length = expand_control_length(ss);
1975 	  if (sp->playing) dac_set_expand_length(sp, expand_control_length(ss));
1976 	}
1977     }
1978 }
1979 
expand_control_set_ramp(mus_float_t hop)1980 void expand_control_set_ramp(mus_float_t hop)
1981 {
1982   int i;
1983   in_set_expand_control_ramp(ss, hop);
1984   for (i = 0; i < ss->max_sounds; i++)
1985     {
1986       snd_info *sp;
1987       sp = ss->sounds[i];
1988       if ((sp) &&
1989 	  (sp->inuse == SOUND_NORMAL))
1990 	{
1991 	  sp->expand_control_ramp = expand_control_ramp(ss);
1992 	  if (sp->playing) dac_set_expand_ramp(sp, expand_control_ramp(ss));
1993 	}
1994     }
1995 }
1996 
expand_control_set_jitter(mus_float_t hop)1997 void expand_control_set_jitter(mus_float_t hop)
1998 {
1999   int i;
2000   in_set_expand_control_jitter(ss, hop);
2001   for (i = 0; i < ss->max_sounds; i++)
2002     {
2003       snd_info *sp;
2004       sp = ss->sounds[i];
2005       if ((sp) &&
2006 	  (sp->inuse == SOUND_NORMAL))
2007 	{
2008 	  sp->expand_control_jitter = expand_control_jitter(ss);
2009 	}
2010     }
2011 }
2012 
contrast_control_set_amp(mus_float_t hop)2013 void contrast_control_set_amp(mus_float_t hop)
2014 {
2015   int i;
2016   in_set_contrast_control_amp(ss, hop);
2017   for (i = 0; i < ss->max_sounds; i++)
2018     {
2019       snd_info *sp;
2020       sp = ss->sounds[i];
2021       if ((sp) &&
2022 	  (sp->inuse == SOUND_NORMAL))
2023 	{
2024 	  sp->contrast_control_amp = contrast_control_amp(ss);
2025 	  if (sp->playing) dac_set_contrast_amp(sp, contrast_control_amp(ss));
2026 	}
2027     }
2028 }
2029 
reverb_control_set_lowpass(mus_float_t hop)2030 void reverb_control_set_lowpass(mus_float_t hop)
2031 {
2032   int i;
2033   in_set_reverb_control_lowpass(ss, hop);
2034   for (i = 0; i < ss->max_sounds; i++)
2035     {
2036       snd_info *sp;
2037       sp = ss->sounds[i];
2038       if ((sp) &&
2039 	  (sp->inuse == SOUND_NORMAL))
2040 	{
2041 	  sp->reverb_control_lowpass = reverb_control_lowpass(ss);
2042 	  if (sp->playing) dac_set_reverb_lowpass(sp, reverb_control_lowpass(ss));
2043 	}
2044     }
2045 }
2046 
reverb_control_set_feedback(mus_float_t hop)2047 void reverb_control_set_feedback(mus_float_t hop)
2048 {
2049   int i;
2050   in_set_reverb_control_feedback(ss, hop);
2051   for (i = 0; i < ss->max_sounds; i++)
2052     {
2053       snd_info *sp;
2054       sp = ss->sounds[i];
2055       if ((sp) &&
2056 	  (sp->inuse == SOUND_NORMAL))
2057 	{
2058 	  sp->reverb_control_feedback = reverb_control_feedback(ss);
2059 	  if (sp->playing) dac_set_reverb_feedback(sp, reverb_control_feedback(ss));
2060 	}
2061     }
2062 }
2063 
2064 
2065 
2066 /* ---------------- status area ----------------
2067  */
2068 
status_report(snd_info * sp,const char * format,...)2069 void status_report(snd_info *sp, const char *format, ...)
2070 {
2071 #if (!USE_NO_GUI)
2072   char *buf;
2073   va_list ap;
2074   if ((!sp) || (!(sp->active)) || (sp->inuse != SOUND_NORMAL)) return;
2075   va_start(ap, format);
2076   buf = vstr(format, ap);
2077   va_end(ap);
2078   set_status(sp, buf, false);
2079   free(buf);
2080 #endif
2081 }
2082 
2083 
clear_status_area(snd_info * sp)2084 void clear_status_area(snd_info *sp)
2085 {
2086   set_status(sp, NULL, true);
2087 }
2088 
2089 
errors_to_status_area(const char * msg,void * data)2090 void errors_to_status_area(const char *msg, void *data)
2091 {
2092   snd_info *sp;
2093   sp = (snd_info *)data;
2094   if (!(snd_ok(sp)))
2095     {
2096       sp = any_selected_sound();
2097       if (!snd_ok(sp)) return;
2098     }
2099   status_report((snd_info *)data, "%s", msg);
2100 }
2101 
2102 
printout_to_status_area(const char * msg,void * data)2103 void printout_to_status_area(const char *msg, void *data)
2104 {
2105   set_status((snd_info *)data, msg, false);
2106 }
2107 
2108 
2109 
2110 
2111 
2112 /* ---------------------------------------- sound objects ---------------------------------------- */
2113 
2114 typedef struct {
2115   int n;
2116 } xen_sound;
2117 
2118 
2119 #define Xen_to_xen_sound(arg) ((xen_sound *)Xen_object_ref(arg))
2120 
xen_sound_to_int(Xen n)2121 int xen_sound_to_int(Xen n)
2122 {
2123   xen_sound *mx;
2124   mx = Xen_to_xen_sound(n);
2125   return(mx->n);
2126 }
2127 
2128 
2129 static Xen_object_type_t xen_sound_tag;
2130 
xen_is_sound(Xen obj)2131 bool xen_is_sound(Xen obj)
2132 {
2133   return(Xen_c_object_is_type(obj, xen_sound_tag));
2134 }
2135 
2136 #if (!HAVE_SCHEME)
xen_sound_free(xen_sound * v)2137 static void xen_sound_free(xen_sound *v) {if (v) free(v);}
2138 
Xen_wrap_free(xen_sound,free_xen_sound,xen_sound_free)2139 Xen_wrap_free(xen_sound, free_xen_sound, xen_sound_free)
2140 #else
2141 static s7_pointer s7_xen_sound_free(s7_scheme *sc, s7_pointer obj)
2142 {
2143   xen_sound *v;
2144   v = (xen_sound *)s7_c_object_value(obj);
2145   if (v) free(v);
2146   return(NULL);
2147 }
2148 #endif
2149 
2150 
2151 static char *xen_sound_to_string(xen_sound *v)
2152 {
2153   #define SOUND_PRINT_BUFFER_SIZE 64
2154   char *buf;
2155   if (!v) return(NULL);
2156   buf = (char *)calloc(SOUND_PRINT_BUFFER_SIZE, sizeof(char));
2157   snprintf(buf, SOUND_PRINT_BUFFER_SIZE, "#<sound %d>", v->n);
2158   return(buf);
2159 }
2160 
2161 
2162 #if HAVE_FORTH || HAVE_RUBY
Xen_wrap_print(xen_sound,print_xen_sound,xen_sound_to_string)2163 Xen_wrap_print(xen_sound, print_xen_sound, xen_sound_to_string)
2164 
2165 static Xen g_xen_sound_to_string(Xen obj)
2166 {
2167   char *vstr;
2168   Xen result;
2169   #define S_xen_sound_to_string "sound->string"
2170   Xen_check_type(xen_is_sound(obj), obj, 1, S_xen_sound_to_string, "a sound");
2171   vstr = xen_sound_to_string(Xen_to_xen_sound(obj));
2172   result = C_string_to_Xen_string(vstr);
2173   free(vstr);
2174   return(result);
2175 }
2176 #else
2177 #if HAVE_SCHEME
g_xen_sound_to_string(s7_scheme * sc,s7_pointer args)2178 static s7_pointer g_xen_sound_to_string(s7_scheme *sc, s7_pointer args)
2179 {
2180   char *vstr;
2181   Xen result;
2182   vstr = xen_sound_to_string(Xen_to_xen_sound(s7_car(args)));
2183   result = C_string_to_Xen_string(vstr);
2184   free(vstr);
2185   return(result);
2186 }
2187 #endif
2188 #endif
2189 
2190 
2191 #if (!HAVE_SCHEME)
xen_sound_equalp(xen_sound * v1,xen_sound * v2)2192 static bool xen_sound_equalp(xen_sound *v1, xen_sound *v2)
2193 {
2194   return((v1 == v2) ||
2195 	 (v1->n == v2->n));
2196 }
2197 
equalp_xen_sound(Xen obj1,Xen obj2)2198 static Xen equalp_xen_sound(Xen obj1, Xen obj2)
2199 {
2200   if ((!(xen_is_sound(obj1))) || (!(xen_is_sound(obj2)))) return(Xen_false);
2201   return(C_bool_to_Xen_boolean(xen_sound_equalp(Xen_to_xen_sound(obj1), Xen_to_xen_sound(obj2))));
2202 }
2203 #endif
2204 
2205 
xen_sound_make(int n)2206 static xen_sound *xen_sound_make(int n)
2207 {
2208   xen_sound *new_v;
2209   new_v = (xen_sound *)malloc(sizeof(xen_sound));
2210   new_v->n = n;
2211   return(new_v);
2212 }
2213 
2214 
new_xen_sound(int n)2215 Xen new_xen_sound(int n)
2216 {
2217   xen_sound *mx;
2218   if (n < 0)
2219     return(Xen_false);
2220 
2221   mx = xen_sound_make(n);
2222   return(Xen_make_object(xen_sound_tag, mx, 0, free_xen_sound));
2223 }
2224 
2225 
2226 #if HAVE_SCHEME
s7_xen_sound_is_equal(s7_scheme * sc,s7_pointer args)2227 static s7_pointer s7_xen_sound_is_equal(s7_scheme *sc, s7_pointer args)
2228 {
2229   s7_pointer p1, p2;
2230   p1 = s7_car(args);
2231   p2 = s7_cadr(args);
2232   if (p1 == p2) return(s7_t(sc));
2233   if (s7_c_object_type(p2) == xen_sound_tag)
2234     return(s7_make_boolean(sc, (((xen_sound *)s7_c_object_value(p1))->n == ((xen_sound *)s7_c_object_value(p2))->n)));
2235   return(s7_f(sc));
2236 }
2237 
2238 
s7_xen_sound_length(s7_scheme * sc,Xen args)2239 static Xen s7_xen_sound_length(s7_scheme *sc, Xen args)
2240 {
2241   return(g_framples(s7_car(args), Xen_integer_zero, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION)));
2242 }
2243 
2244 
s7_xen_sound_copy(s7_scheme * sc,Xen args)2245 static Xen s7_xen_sound_copy(s7_scheme *sc, Xen args)
2246 {
2247   snd_info *sp;
2248   s7_pointer obj;
2249   obj = s7_car(args);
2250   sp = get_sp(obj);
2251   if (sp)
2252     {
2253       io_error_t err;
2254       char *name;
2255       name = snd_tempnam();
2256       if (mus_header_writable(sp->hdr->type, sp->hdr->sample_type))
2257 	err = save_edits_without_display(sp, name, sp->hdr->type, sp->hdr->sample_type, sp->hdr->srate, NULL, AT_CURRENT_EDIT_POSITION);
2258       else err = save_edits_without_display(sp, name, MUS_NEXT, MUS_OUT_SAMPLE_TYPE, sp->hdr->srate, NULL, AT_CURRENT_EDIT_POSITION);
2259       sp = snd_open_file(name, FILE_READ_WRITE);
2260       free(name);
2261       if (sp)
2262 	return(new_xen_sound(sp->index));
2263       if (is_serious_io_error(err))
2264 	Xen_error(Xen_make_error_type("IO-error"),
2265 		  Xen_list_2(C_string_to_Xen_string("copy sound: can't save edits, ~A"),
2266 			     C_string_to_Xen_string(io_error_name(err))));
2267     }
2268   return(Xen_false);
2269 }
2270 
2271 
s7_xen_sound_fill(s7_scheme * sc,Xen args)2272 static Xen s7_xen_sound_fill(s7_scheme *sc, Xen args)
2273 {
2274   snd_info *sp;
2275   s7_pointer obj;
2276 
2277   obj = s7_car(args);
2278   sp = get_sp(obj);
2279   if (sp)
2280     {
2281       mus_float_t valf;
2282       chan_info *cp;
2283       uint32_t i;
2284       s7_pointer val;
2285 
2286       val = s7_cadr(args);
2287       valf = Xen_real_to_C_double(val);
2288       if (valf == 0.0)
2289 	{
2290 	  for (i = 0; i < sp->nchans; i++)
2291 	    {
2292 	      cp = sp->chans[i];
2293 	      scale_channel(cp, 0.0, 0, current_samples(cp), cp->edit_ctr, false);
2294 	      update_graph(cp);
2295 	    }
2296 	}
2297       else
2298 	{
2299 	  /* this was #if (!HAVE_SCHEME) which makes no sense -- I think it meant (!HAVE_RUN)
2300 	   *   but that means (fill! <sound>) fails if optimization is off.
2301 	   */
2302 	  mus_long_t len = -1, j;
2303 	  mus_float_t *data = NULL;
2304 
2305 	  for (i = 0; i < sp->nchans; i++)
2306 	    {
2307 	      cp = sp->chans[i];
2308 	      if ((!data) || (current_samples(cp) != len))
2309 		{
2310 		  len = current_samples(cp);
2311 		  if (data) free(data);
2312 		  data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
2313 		  for (j = 0; j < len; j++)
2314 		    data[j] = valf;
2315 		}
2316 	      if (change_samples(0, len, data, cp, "fill! sound", cp->edit_ctr, fabs(valf)))
2317 		update_graph(cp);
2318 	    }
2319 	  free(data);
2320 	}
2321     }
2322   return(Xen_false);
2323 }
2324 #endif
2325 
2326 
init_xen_sound(void)2327 static void init_xen_sound(void)
2328 {
2329 #if HAVE_SCHEME
2330   xen_sound_tag = s7_make_c_type(s7, "<sound>");
2331   s7_c_type_set_gc_free(s7, xen_sound_tag, s7_xen_sound_free);
2332   s7_c_type_set_is_equal(s7, xen_sound_tag, s7_xen_sound_is_equal);
2333   s7_c_type_set_length(s7, xen_sound_tag, s7_xen_sound_length);
2334   s7_c_type_set_copy(s7, xen_sound_tag, s7_xen_sound_copy);
2335   s7_c_type_set_fill(s7, xen_sound_tag, s7_xen_sound_fill);
2336   s7_c_type_set_to_string(s7, xen_sound_tag, g_xen_sound_to_string);
2337 #else
2338 #if HAVE_RUBY
2339   xen_sound_tag = Xen_make_object_type("XenSound", sizeof(xen_sound));
2340 #else
2341   xen_sound_tag = Xen_make_object_type("Sound", sizeof(xen_sound));
2342 #endif
2343 #endif
2344 
2345 #if HAVE_FORTH
2346   fth_set_object_inspect(xen_sound_tag,   print_xen_sound);
2347   fth_set_object_dump(xen_sound_tag,      g_xen_sound_to_string);
2348   fth_set_object_equal(xen_sound_tag,     equalp_xen_sound);
2349   fth_set_object_free(xen_sound_tag,      free_xen_sound);
2350 #endif
2351 
2352 #if HAVE_RUBY
2353   rb_define_method(xen_sound_tag, "to_s",     Xen_procedure_cast print_xen_sound, 0);
2354   rb_define_method(xen_sound_tag, "eql?",     Xen_procedure_cast equalp_xen_sound, 1);
2355   rb_define_method(xen_sound_tag, "==",       Xen_procedure_cast equalp_xen_sound, 1);
2356   rb_define_method(xen_sound_tag, "to_str",   Xen_procedure_cast g_xen_sound_to_string, 0);
2357 #endif
2358 }
2359 
2360 /* -------------------------------------------------------------------------------- */
2361 
g_integer_to_sound(Xen n)2362 static Xen g_integer_to_sound(Xen n)
2363 {
2364   #define H_integer_to_sound "(" S_integer_to_sound " n) returns a sound object corresponding to the given integer"
2365   int index;
2366   Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_sound, "an integer");
2367   index = Xen_integer_to_C_int(n);
2368   if (get_sp_1(index))
2369     return(new_xen_sound(index));
2370   return(Xen_false);
2371 }
2372 
2373 
g_sound_to_integer(Xen n)2374 static Xen g_sound_to_integer(Xen n)
2375 {
2376   #define H_sound_to_integer "(" S_sound_to_integer " id) returns the integer corresponding to the given sound"
2377   Xen_check_type(xen_is_sound(n), n, 1, S_sound_to_integer, "a sound");
2378   return(C_int_to_Xen_integer(xen_sound_to_int(n)));
2379 }
2380 
2381 
snd_no_such_sound_error(const char * caller,Xen n)2382 Xen snd_no_such_sound_error(const char *caller, Xen n)
2383 {
2384   Xen_error(Xen_make_error_type("no-such-sound"),
2385 	    Xen_list_3(C_string_to_Xen_string("~A: no such sound: ~A"),
2386 		       C_string_to_Xen_string(caller),
2387 		       n));
2388   return(Xen_false);
2389 }
2390 
2391 
g_is_sound(Xen snd)2392 static Xen g_is_sound(Xen snd)
2393 {
2394   #define H_is_sound "(" S_is_sound " snd): " PROC_TRUE " if 'snd' (a sound object or an integer) is an active (accessible) sound"
2395 
2396   if (Xen_is_integer(snd) || xen_is_sound(snd))
2397     {
2398       snd_info *sp;
2399       sp = get_sp(snd);
2400       return(C_bool_to_Xen_boolean((sp) &&
2401 				   (snd_ok(sp)) &&
2402 				   (sp->inuse == SOUND_NORMAL)));
2403     }
2404   return(Xen_false);
2405 }
2406 
2407 
g_select_sound(Xen snd)2408 static Xen g_select_sound(Xen snd)
2409 {
2410   #define H_select_sound "(" S_select_sound " snd): make sound 'snd' (a sound object or an index) the default sound for \
2411 any editing operations."
2412   snd_info *sp;
2413 
2414   Xen_check_type(Xen_is_integer(snd) || xen_is_sound(snd), snd, 1, S_select_sound, "a sound object or index");
2415 
2416   sp = get_sp(snd);
2417   if (sp)
2418     {
2419       select_channel(sp, 0);
2420       return(snd);
2421     }
2422 
2423   return(snd_no_such_sound_error(S_select_sound, snd));
2424 }
2425 
2426 
g_select_channel(Xen chn_n)2427 static Xen g_select_channel(Xen chn_n)
2428 {
2429   #define H_select_channel "(" S_select_channel " :optional (chn 0)): make channel 'chn' of the currently selected sound the default \
2430 channel for editing."
2431   snd_info *sp;
2432   int chan = 0;
2433 
2434   Snd_assert_sound(S_select_channel, chn_n, 1);
2435   if (Xen_is_integer(chn_n)) chan = Xen_integer_to_C_int(chn_n);
2436 
2437   sp = any_selected_sound();
2438   if ((sp) &&
2439       (chan >= 0) &&
2440       (chan < (int)sp->nchans))
2441     {
2442       select_channel(sp, chan);
2443       return(chn_n);
2444     }
2445 
2446   return(snd_no_such_channel_error(S_select_channel, C_string_to_Xen_string(S_selected_sound), chn_n));
2447 }
2448 
2449 
g_find_sound(Xen filename,Xen which)2450 static Xen g_find_sound(Xen filename, Xen which)
2451 {
2452   #define H_find_sound "(" S_find_sound " name :optional (nth 0)): return the sound associated with file 'name'. \
2453 If more than one such sound exists, 'nth' chooses which one to return."
2454   snd_info *sp;
2455 
2456   Xen_check_type(Xen_is_string(filename), filename, 1, S_find_sound, "a string");
2457   Xen_check_type(Xen_is_integer_or_unbound(which), which, 2, S_find_sound, "an integer");
2458 
2459   sp = find_sound(Xen_string_to_C_string(filename), (Xen_is_integer(which)) ? Xen_integer_to_C_int(which) : 0);
2460   if (sp) return(C_int_to_Xen_sound(sp->index));
2461 
2462   return(Xen_false);
2463 }
2464 
2465 
2466 typedef enum {SP_SYNC, SP_READ_ONLY, SP_NCHANS, SP_CONTRASTING, SP_EXPANDING, SP_REVERBING, SP_FILTERING, SP_FILTER_ORDER,
2467 	      SP_SRATE, SP_SAMPLE_TYPE, SP_DATA_LOCATION, SP_HEADER_TYPE, SP_SAVE_CONTROLS, SP_RESTORE_CONTROLS, SP_SELECTED_CHANNEL,
2468 	      SP_COMMENT, SP_FILE_NAME, SP_SHORT_FILE_NAME, SP_CLOSE, SP_UPDATE, SP_SHOW_CONTROLS,
2469 	      SP_FILTER_DBING, SP_SPEED_TONES, SP_SPEED_STYLE, SP_RESET_CONTROLS,
2470 	      SP_AMP, SP_CONTRAST, SP_CONTRAST_AMP, SP_EXPAND, SP_EXPAND_LENGTH, SP_EXPAND_RAMP, SP_EXPAND_HOP,
2471 	      SP_SPEED, SP_REVERB_LENGTH, SP_REVERB_FEEDBACK, SP_REVERB_SCALE, SP_REVERB_LOW_PASS,
2472 	      SP_REVERB_DECAY, SP_PROPERTIES, SP_FILTER_COEFFS, SP_DATA_SIZE, SP_FILTER_HZING, SP_EXPAND_JITTER,
2473 	      SP_CONTRAST_BOUNDS, SP_AMP_BOUNDS, SP_SPEED_BOUNDS, SP_EXPAND_BOUNDS, SP_REVERB_LENGTH_BOUNDS, SP_REVERB_SCALE_BOUNDS,
2474 	      SP_FILTER_ENVELOPE
2475 } sp_field_t;
2476 
2477 
sound_get(Xen snd,sp_field_t fld,const char * caller)2478 static Xen sound_get(Xen snd, sp_field_t fld, const char *caller)
2479 {
2480   snd_info *sp;
2481   Xen res = Xen_empty_list;
2482 
2483   if (Xen_is_true(snd))
2484     {
2485       int i;
2486       for (i = ss->max_sounds - 1; i >= 0; i--)
2487 	{
2488 	  sp = ss->sounds[i];
2489 	  if ((sp) &&
2490 	      (sp->inuse == SOUND_NORMAL))
2491 	    res = Xen_cons(sound_get(C_int_to_Xen_integer(i), fld, caller), res);
2492 	}
2493       return(res);
2494     }
2495 
2496   if (xen_is_player(snd))
2497     {
2498       sp = get_player_sound(snd);
2499       if (!sp)
2500 	return(no_such_player_error(caller, snd));
2501     }
2502   else
2503     {
2504       Snd_assert_sound(caller, snd, 1);
2505       sp = get_sp(snd);
2506       if (!sp)
2507 	return(snd_no_such_sound_error(caller, snd));
2508     }
2509   if ((!sp) ||
2510       (sp->inuse == SOUND_WRAPPER))
2511     return(snd_no_such_sound_error(caller, snd));
2512 
2513   switch (fld)
2514     {
2515     case SP_SYNC:                return(C_int_to_Xen_integer(sp->sync));
2516     case SP_READ_ONLY:           return(C_bool_to_Xen_boolean(sp->user_read_only == FILE_READ_ONLY));
2517     case SP_NCHANS:              return(C_int_to_Xen_integer(sp->nchans));
2518     case SP_EXPANDING:           return(C_bool_to_Xen_boolean(sp->expand_control_on));
2519     case SP_CONTRASTING:         return(C_bool_to_Xen_boolean(sp->contrast_control_on));
2520     case SP_REVERBING:           return(C_bool_to_Xen_boolean(sp->reverb_control_on));
2521     case SP_FILTERING:           return(C_bool_to_Xen_boolean(sp->filter_control_on));
2522     case SP_FILTER_DBING:        return(C_bool_to_Xen_boolean(sp->filter_control_in_dB));
2523     case SP_FILTER_HZING:        return(C_bool_to_Xen_boolean(sp->filter_control_in_hz));
2524     case SP_FILTER_ORDER:        return(C_int_to_Xen_integer(sp->filter_control_order));
2525     case SP_SRATE:               return(C_int_to_Xen_integer(sp->hdr->srate));
2526     case SP_SAMPLE_TYPE:         return(C_int_to_Xen_integer(sp->hdr->sample_type));
2527     case SP_HEADER_TYPE:         return(C_int_to_Xen_integer(sp->hdr->type));
2528     case SP_DATA_LOCATION:       return(C_llong_to_Xen_llong(sp->hdr->data_location));
2529     case SP_DATA_SIZE:           return(C_llong_to_Xen_llong(mus_samples_to_bytes(sp->hdr->sample_type, sp->hdr->samples)));
2530     case SP_SAVE_CONTROLS:       if (has_widgets(sp)) save_controls(sp);     break;
2531     case SP_RESTORE_CONTROLS:    if (has_widgets(sp)) restore_controls(sp);  break;
2532     case SP_RESET_CONTROLS:      if (has_widgets(sp)) reset_controls(sp);    break;
2533     case SP_FILE_NAME:           return(C_string_to_Xen_string(sp->filename));
2534     case SP_SHORT_FILE_NAME:     return(C_string_to_Xen_string(sp->short_filename));
2535     case SP_CLOSE:               if (!(is_player_sound(sp))) snd_close_file(sp); break;
2536     case SP_SHOW_CONTROLS:       if (has_widgets(sp)) return(C_bool_to_Xen_boolean(showing_controls(sp))); break;
2537     case SP_SPEED_TONES:         return(C_int_to_Xen_integer(sp->speed_control_tones));
2538     case SP_SPEED_STYLE:         return(C_int_to_Xen_integer((int)(sp->speed_control_style)));
2539     case SP_COMMENT:             return(C_string_to_Xen_string(sp->hdr->comment));
2540     case SP_AMP:                 return(C_double_to_Xen_real(sp->amp_control));
2541     case SP_CONTRAST:            return(C_double_to_Xen_real(sp->contrast_control));
2542     case SP_CONTRAST_AMP:        return(C_double_to_Xen_real(sp->contrast_control_amp));
2543     case SP_EXPAND:              return(C_double_to_Xen_real(sp->expand_control));
2544     case SP_EXPAND_LENGTH:       return(C_double_to_Xen_real(sp->expand_control_length));
2545     case SP_EXPAND_RAMP:         return(C_double_to_Xen_real(sp->expand_control_ramp));
2546     case SP_EXPAND_HOP:          return(C_double_to_Xen_real(sp->expand_control_hop));
2547     case SP_EXPAND_JITTER:       return(C_double_to_Xen_real(sp->expand_control_jitter));
2548     case SP_REVERB_LENGTH:       return(C_double_to_Xen_real(sp->reverb_control_length));
2549     case SP_REVERB_FEEDBACK:     return(C_double_to_Xen_real(sp->reverb_control_feedback));
2550     case SP_REVERB_SCALE:        return(C_double_to_Xen_real(sp->reverb_control_scale));
2551     case SP_REVERB_LOW_PASS:     return(C_double_to_Xen_real(sp->reverb_control_lowpass));
2552     case SP_REVERB_DECAY:        return(C_double_to_Xen_real(sp->reverb_control_decay));
2553 
2554     case SP_AMP_BOUNDS:
2555       return(Xen_list_2(C_double_to_Xen_real(sp->amp_control_min), C_double_to_Xen_real(sp->amp_control_max)));
2556 
2557     case SP_CONTRAST_BOUNDS:
2558       return(Xen_list_2(C_double_to_Xen_real(sp->contrast_control_min), C_double_to_Xen_real(sp->contrast_control_max)));
2559 
2560     case SP_EXPAND_BOUNDS:
2561       return(Xen_list_2(C_double_to_Xen_real(sp->expand_control_min), C_double_to_Xen_real(sp->expand_control_max)));
2562 
2563     case SP_SPEED_BOUNDS:
2564       return(Xen_list_2(C_double_to_Xen_real(sp->speed_control_min), C_double_to_Xen_real(sp->speed_control_max)));
2565 
2566     case SP_REVERB_LENGTH_BOUNDS:
2567       return(Xen_list_2(C_double_to_Xen_real(sp->reverb_control_length_min), C_double_to_Xen_real(sp->reverb_control_length_max)));
2568 
2569     case SP_REVERB_SCALE_BOUNDS:
2570       return(Xen_list_2(C_double_to_Xen_real(sp->reverb_control_scale_min), C_double_to_Xen_real(sp->reverb_control_scale_max)));
2571 
2572     case SP_SELECTED_CHANNEL:
2573       if (sp->selected_channel != NO_SELECTION)
2574 	return(C_int_to_Xen_integer(sp->selected_channel));
2575       return(Xen_false);
2576 
2577     case SP_UPDATE:
2578       if (!(is_player_sound(sp)))
2579 	{
2580 	  mus_sound_forget(sp->filename); /* old record must be out-of-date, so flush it (write date can be troublesome) */
2581 	  sp = snd_update_within_xen(sp, caller);
2582 	  if (sp)
2583 	    return(C_int_to_Xen_sound(sp->index));
2584 	}
2585       break;
2586 
2587     case SP_PROPERTIES:
2588       if (!(is_player_sound(sp)))
2589 	{
2590 	  if (!(Xen_is_vector(sp->properties)))
2591 	    {
2592 	      sp->properties = Xen_make_vector(1, Xen_empty_list);
2593 	      sp->properties_loc = snd_protect(sp->properties);
2594 	    }
2595 	  return(Xen_vector_ref(sp->properties, 0));
2596 	}
2597       break;
2598 
2599     case SP_SPEED:
2600 #if XEN_HAVE_RATIOS
2601       if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
2602 	{
2603 	  if (sp->speed_control_direction == -1)
2604 	    return(Xen_make_ratio(C_int_to_Xen_integer(-sp->speed_control_numerator), C_int_to_Xen_integer(sp->speed_control_denominator)));
2605 	  return(Xen_make_ratio(C_int_to_Xen_integer(sp->speed_control_numerator), C_int_to_Xen_integer(sp->speed_control_denominator)));
2606 	}
2607 #endif
2608       if (sp->speed_control_direction == -1)
2609 	return(C_double_to_Xen_real((-(sp->speed_control))));
2610       return(C_double_to_Xen_real(sp->speed_control));
2611 
2612     case SP_FILTER_COEFFS:
2613       if (sp->filter_control_envelope)
2614 	{
2615 	  int len;
2616 	  mus_float_t *coeffs, *data;
2617 	  len = sp->filter_control_order;
2618 	  coeffs = (mus_float_t *)calloc(len, len * sizeof(mus_float_t));
2619 	  data = sample_linear_env(sp->filter_control_envelope, len);
2620 	  mus_make_fir_coeffs(len, data, coeffs);
2621 	  free(data);
2622 	  return(xen_make_vct(len, coeffs));
2623 	}
2624       break;
2625 
2626     case SP_FILTER_ENVELOPE:
2627       if (sp->filter_control_envelope)
2628 	return(env_to_xen(sp->filter_control_envelope));
2629       break;
2630     }
2631   return(Xen_false);
2632 }
2633 
2634 
sound_get_global(Xen snd,sp_field_t fld,const char * caller)2635 static Xen sound_get_global(Xen snd, sp_field_t fld, const char *caller)
2636 {
2637   if (!Xen_is_bound(snd))
2638     switch (fld)
2639       {
2640       case SP_FILTER_DBING:         return(C_bool_to_Xen_boolean(filter_control_in_dB(ss)));
2641       case SP_FILTER_HZING:         return(C_bool_to_Xen_boolean(filter_control_in_hz(ss)));
2642       case SP_FILTER_ORDER:         return(C_int_to_Xen_integer(filter_control_order(ss)));
2643       case SP_SHOW_CONTROLS:        return(C_bool_to_Xen_boolean(in_show_controls(ss)));
2644       case SP_SPEED_TONES:          return(C_int_to_Xen_integer(speed_control_tones(ss)));
2645       case SP_SPEED_STYLE:          return(C_int_to_Xen_integer((int)(speed_control_style(ss))));
2646       case SP_CONTRAST_AMP:         return(C_double_to_Xen_real(contrast_control_amp(ss)));
2647       case SP_EXPAND_LENGTH:        return(C_double_to_Xen_real(expand_control_length(ss)));
2648       case SP_EXPAND_RAMP:          return(C_double_to_Xen_real(expand_control_ramp(ss)));
2649       case SP_EXPAND_HOP:           return(C_double_to_Xen_real(expand_control_hop(ss)));
2650       case SP_EXPAND_JITTER:        return(C_double_to_Xen_real(expand_control_jitter(ss)));
2651       case SP_REVERB_FEEDBACK:      return(C_double_to_Xen_real(reverb_control_feedback(ss)));
2652       case SP_REVERB_LOW_PASS:      return(C_double_to_Xen_real(reverb_control_lowpass(ss)));
2653       case SP_REVERB_DECAY:         return(C_double_to_Xen_real(reverb_control_decay(ss)));
2654 
2655       case SP_AMP_BOUNDS:
2656 	return(Xen_list_2(C_double_to_Xen_real(amp_control_min(ss)), C_double_to_Xen_real(amp_control_max(ss))));
2657 
2658       case SP_CONTRAST_BOUNDS:
2659 	return(Xen_list_2(C_double_to_Xen_real(contrast_control_min(ss)), C_double_to_Xen_real(contrast_control_max(ss))));
2660 
2661       case SP_EXPAND_BOUNDS:
2662 	return(Xen_list_2(C_double_to_Xen_real(expand_control_min(ss)), C_double_to_Xen_real(expand_control_max(ss))));
2663 
2664       case SP_SPEED_BOUNDS:
2665 	return(Xen_list_2(C_double_to_Xen_real(speed_control_min(ss)), C_double_to_Xen_real(speed_control_max(ss))));
2666 
2667       case SP_REVERB_LENGTH_BOUNDS:
2668 	return(Xen_list_2(C_double_to_Xen_real(reverb_control_length_min(ss)), C_double_to_Xen_real(reverb_control_length_max(ss))));
2669 
2670       case SP_REVERB_SCALE_BOUNDS:
2671 	return(Xen_list_2(C_double_to_Xen_real(reverb_control_scale_min(ss)), C_double_to_Xen_real(reverb_control_scale_max(ss))));
2672 
2673       default:
2674 	break;
2675       }
2676   return(sound_get(snd, fld, caller));
2677 }
2678 
2679 
sound_set(Xen snd,Xen val,sp_field_t fld,const char * caller)2680 static Xen sound_set(Xen snd, Xen val, sp_field_t fld, const char *caller)
2681 {
2682   snd_info *sp;
2683   int i, ival;
2684   mus_float_t fval;
2685 
2686   if (Xen_is_true(snd))
2687     {
2688       for (i = 0; i < ss->max_sounds; i++)
2689 	{
2690 	  sp = ss->sounds[i];
2691 	  if ((sp) &&
2692 	      (sp->inuse == SOUND_NORMAL))
2693 	    sound_set(C_int_to_Xen_integer(i), val, fld, caller);
2694 	}
2695       return(val);
2696     }
2697 
2698   if (xen_is_player(snd))
2699     {
2700       sp = get_player_sound(snd);
2701       if (!sp)
2702 	return(no_such_player_error(caller, snd));
2703     }
2704   else
2705     {
2706       Snd_assert_sound(caller, snd, 1);
2707       sp = get_sp(snd);
2708       if (!sp)
2709 	return(snd_no_such_sound_error(caller, snd));
2710     }
2711   if ((!sp) ||
2712       (sp->inuse == SOUND_WRAPPER))
2713     return(snd_no_such_sound_error(caller, snd));
2714 
2715   switch (fld)
2716     {
2717     case SP_SYNC:
2718       if (Xen_is_integer(val))
2719 	syncb(sp, Xen_integer_to_C_int(val));
2720       else syncb(sp, (int)Xen_boolean_to_C_bool(val));
2721       break;
2722 
2723     case SP_READ_ONLY:
2724       if (has_widgets(sp))
2725 	{
2726 	  sp->user_read_only = (Xen_boolean_to_C_bool(val) ? FILE_READ_ONLY : FILE_READ_WRITE);
2727 	  if ((sp->user_read_only == FILE_READ_ONLY) ||
2728 	      (sp->file_read_only == FILE_READ_ONLY))
2729 	    show_lock(sp);
2730 	  else hide_lock(sp);
2731 	}
2732       break;
2733 
2734     case SP_EXPANDING:
2735       toggle_expand_button(sp, Xen_boolean_to_C_bool(val));
2736       break;
2737 
2738     case SP_CONTRASTING:
2739       toggle_contrast_button(sp, Xen_boolean_to_C_bool(val));
2740       break;
2741 
2742     case SP_REVERBING:
2743       toggle_reverb_button(sp, Xen_boolean_to_C_bool(val));
2744       break;
2745 
2746     case SP_FILTERING:
2747       toggle_filter_button(sp, Xen_boolean_to_C_bool(val));
2748       break;
2749 
2750     case SP_FILTER_DBING:
2751       set_filter_in_dB(sp, Xen_boolean_to_C_bool(val));
2752       break;
2753 
2754     case SP_FILTER_HZING:
2755       set_filter_in_hz(sp, Xen_boolean_to_C_bool(val));
2756       break;
2757 
2758     case SP_FILTER_ORDER:
2759       set_filter_order(sp, Xen_integer_to_C_int(val));
2760       break;
2761 
2762     case SP_SHOW_CONTROLS:
2763       if (has_widgets(sp))
2764 	{
2765 	  if (Xen_boolean_to_C_bool(val))
2766 	    show_controls(sp);
2767 	  else hide_controls(sp);
2768 	}
2769       break;
2770 
2771     case SP_SPEED_TONES:
2772       sp->speed_control_tones = Xen_integer_to_C_int(val);
2773       if (sp->speed_control_tones <= 0)
2774 	sp->speed_control_tones = DEFAULT_SPEED_CONTROL_TONES;
2775       set_speed(sp, sp->speed_control); /* update label etc */
2776       break;
2777 
2778     case SP_SPEED_STYLE:
2779       sp->speed_control_style = (speed_style_t)Xen_integer_to_C_int(val); /* range checked already */
2780 #if XEN_HAVE_RATIOS
2781       if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
2782 	snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
2783 #endif
2784       set_speed(sp, sp->speed_control); /* update label etc */
2785       break;
2786 
2787     case SP_SRATE:
2788       if (!(is_player_sound(sp)))
2789 	{
2790 	  if (Xen_is_integer(val))
2791 	    ival = Xen_integer_to_C_int(val);
2792 	  else
2793 	    {
2794 	      if (Xen_is_double(val))
2795 		ival = snd_round(Xen_real_to_C_double(val));
2796 	      else ival = 44100;
2797 	    }
2798 	  if ((ival <= 0) || (ival > 100000000))
2799 	    Xen_out_of_range_error(S_set S_srate, 1, val, "impossible srate");
2800 	  mus_sound_set_srate(sp->filename, ival);
2801 	  sp->hdr->srate = ival;
2802 	  /* if there are pending edits, we certainly don't want to flush them in this case! */
2803 	  if (!(has_unsaved_edits(sp)))
2804 	    snd_update_within_xen(sp, caller);
2805 	  else
2806 	    {
2807 	      /* reset x axis bounds */
2808 	      uint32_t i;
2809 	      for (i = 0; i < sp->nchans; i++)
2810 		set_x_axis_x0x1(sp->chans[i], 0.0, (double)(current_samples(sp->chans[i])) / (double)ival);
2811 	    }
2812 	}
2813       break;
2814 
2815     case SP_NCHANS:
2816       if (!(is_player_sound(sp)))
2817 	{
2818 	  ival = Xen_integer_to_C_int(val);
2819 	  if ((ival <= 0) || (ival > MUS_MAX_CHANS))
2820 	    Xen_out_of_range_error(S_set S_channels, 1, val, "highly unlikely number of channels");
2821 	  mus_sound_set_chans(sp->filename, ival);
2822 	  sp->hdr->chans = ival;
2823 	  snd_update_within_xen(sp, caller);
2824 	}
2825       break;
2826 
2827     case SP_SAMPLE_TYPE:
2828       if (!(is_player_sound(sp)))
2829 	{
2830 	  mus_sample_t ival;
2831 	  ival = (mus_sample_t)Xen_integer_to_C_int(val);
2832 	  if (mus_is_sample_type(ival))
2833 	    {
2834 	      mus_sample_t old_format;
2835 	      old_format = sp->hdr->sample_type;
2836 	      mus_sound_set_sample_type(sp->filename, ival);
2837 	      sp->hdr->sample_type = ival;
2838 	      if (mus_bytes_per_sample(old_format) != mus_bytes_per_sample(ival))
2839 		{
2840 		  sp->hdr->samples = (sp->hdr->samples * mus_bytes_per_sample(old_format)) / mus_bytes_per_sample(ival);
2841 		  mus_sound_set_samples(sp->filename, sp->hdr->samples);
2842 		}
2843 	      /* clear peak amp envs, if any -- is this right?  (snd-update below...) */
2844 	      for (i = 0; i < (int)sp->nchans; i++)
2845 		{
2846 		  chan_info *cp;
2847 		  cp = sp->chans[i];
2848 		  if ((cp) && (cp->edits[cp->edit_ctr]->peak_env))
2849 		    cp->edits[cp->edit_ctr]->peak_env = free_peak_env(cp, cp->edit_ctr);
2850 		}
2851 	      snd_update_within_xen(sp, caller);
2852 	    }
2853 	  else Xen_out_of_range_error(S_set S_sample_type, 1, val, "unknown sample type");
2854 	}
2855       break;
2856 
2857     case SP_HEADER_TYPE:
2858       if (!(is_player_sound(sp)))
2859 	{
2860 	  mus_header_t typ;
2861 	  typ = (mus_header_t)Xen_integer_to_C_int(val);
2862 	  if (mus_is_header_type(typ))
2863 	    {
2864 	      mus_sound_set_header_type(sp->filename, typ);
2865 	      snd_update_within_xen(sp, caller);
2866 	    }
2867 	  else Xen_out_of_range_error(S_set S_header_type, 1, val, "unknown header type");
2868 	}
2869       break;
2870 
2871     case SP_DATA_LOCATION:
2872       if (!(is_player_sound(sp)))
2873 	{
2874 	  mus_long_t loc;
2875 	  loc = Xen_llong_to_C_llong(val);
2876 	  if (loc >= 0)
2877 	    {
2878 	      mus_sound_set_data_location(sp->filename, loc);
2879 	      snd_update_within_xen(sp, caller);
2880 	    }
2881 	  else Xen_out_of_range_error(S_set S_data_location, 1, val, "data location < 0?");
2882 	}
2883       break;
2884 
2885     case SP_DATA_SIZE:
2886       if (!(is_player_sound(sp)))
2887 	{
2888 	  mus_long_t size;
2889 	  size = Xen_llong_to_C_llong(val);
2890 	  if (size >= 0)
2891 	    {
2892 	      mus_sound_set_samples(sp->filename, mus_bytes_to_samples(sp->hdr->sample_type, size));
2893 	      snd_update_within_xen(sp, caller);
2894 	    }
2895 	  else Xen_out_of_range_error(S_set S_data_size, 1, val, "data size < 0?");
2896 	}
2897       break;
2898 
2899     case SP_COMMENT:
2900       if (!(is_player_sound(sp)))
2901 	{
2902 	  if (sp->hdr->comment) free(sp->hdr->comment);
2903 	  if (Xen_is_false(val))
2904 	    sp->hdr->comment = NULL;
2905 	  else sp->hdr->comment = mus_strdup(Xen_string_to_C_string(val));
2906 	}
2907       break;
2908 
2909     case SP_PROPERTIES:
2910       if (!(is_player_sound(sp)))
2911 	{
2912 	  if (!(Xen_is_vector(sp->properties)))
2913 	    {
2914 	      sp->properties = Xen_make_vector(1, Xen_empty_list);
2915 	      sp->properties_loc = snd_protect(sp->properties);
2916 	    }
2917 	  Xen_vector_set(sp->properties, 0, val);
2918 	  return(Xen_vector_ref(sp->properties, 0));
2919 	}
2920       break;
2921 
2922     case SP_AMP:
2923       fval = Xen_real_to_C_double(val);
2924       if (fval >= 0.0) set_amp(sp, fval);
2925       return(C_double_to_Xen_real(sp->amp_control));
2926 
2927     case SP_AMP_BOUNDS:
2928       sp->amp_control_min = Xen_real_to_C_double(Xen_car(val));
2929       sp->amp_control_max = Xen_real_to_C_double(Xen_cadr(val));
2930       set_amp(sp, mus_fclamp(sp->amp_control_min, sp->amp_control, sp->amp_control_max));
2931       return(val);
2932 
2933     case SP_CONTRAST:
2934       set_contrast(sp, Xen_real_to_C_double(val));
2935       return(C_double_to_Xen_real(sp->contrast_control));
2936 
2937     case SP_CONTRAST_BOUNDS:
2938       sp->contrast_control_min = Xen_real_to_C_double(Xen_car(val));
2939       sp->contrast_control_max = Xen_real_to_C_double(Xen_cadr(val));
2940       set_contrast(sp, mus_fclamp(sp->contrast_control_min, sp->contrast_control, sp->contrast_control_max));
2941       return(val);
2942 
2943     case SP_CONTRAST_AMP:
2944       sp->contrast_control_amp = Xen_real_to_C_double(val);
2945       if (sp->playing) dac_set_contrast_amp(sp, sp->contrast_control_amp);
2946       break;
2947 
2948     case SP_EXPAND:
2949       fval = Xen_real_to_C_double(val);
2950       if (fval > 0.0) set_expand(sp, fval);
2951       return(C_double_to_Xen_real(sp->expand_control));
2952 
2953     case SP_EXPAND_BOUNDS:
2954       sp->expand_control_min = Xen_real_to_C_double(Xen_car(val));
2955       sp->expand_control_max = Xen_real_to_C_double(Xen_cadr(val));
2956       set_expand(sp, mus_fclamp(sp->expand_control_min, sp->expand_control, sp->expand_control_max));
2957       return(val);
2958 
2959     case SP_EXPAND_LENGTH:
2960       fval = Xen_real_to_C_double(val);
2961       if (fval > 0.0)
2962 	{
2963 	  sp->expand_control_length = fval;
2964 	  if (sp->playing) dac_set_expand_length(sp, sp->expand_control_length);
2965 	}
2966       else Xen_out_of_range_error(S_set S_expand_control_length, 1, val, "length <= 0.0?");
2967       return(C_double_to_Xen_real(sp->expand_control_length));
2968 
2969     case SP_EXPAND_RAMP:
2970       fval = Xen_real_to_C_double(val);
2971       if ((fval >= 0.0) && (fval < 0.5))
2972 	{
2973 	  sp->expand_control_ramp = fval;
2974 	  if (sp->playing) dac_set_expand_ramp(sp, fval);
2975 	}
2976       return(C_double_to_Xen_real(sp->expand_control_ramp));
2977 
2978     case SP_EXPAND_HOP:
2979       fval = Xen_real_to_C_double(val);
2980       if (fval > 0.0)
2981 	{
2982 	  sp->expand_control_hop = fval;
2983 	  if (sp->playing) dac_set_expand_hop(sp, fval);
2984 	}
2985       else Xen_out_of_range_error(S_set S_expand_control_hop, 1, val, "hop <= 0.0?");
2986       return(C_double_to_Xen_real(sp->expand_control_hop));
2987 
2988     case SP_EXPAND_JITTER:
2989       fval = mus_fclamp(0.0, Xen_real_to_C_double(val), 100.0);
2990       sp->expand_control_jitter = fval;
2991       return(C_double_to_Xen_real(sp->expand_control_jitter));
2992 
2993     case SP_SPEED:
2994 #if XEN_HAVE_RATIOS
2995       if ((sp->speed_control_style == SPEED_CONTROL_AS_RATIO) &&
2996 	  (Xen_is_ratio(val)))
2997 	{
2998 	  sp->speed_control_numerator = (int)Xen_numerator(val);
2999 	  sp->speed_control_denominator = (int)Xen_denominator(val);
3000 	  fval = (mus_float_t)(sp->speed_control_numerator) / (mus_float_t)(sp->speed_control_denominator);
3001 	  if (sp->speed_control_numerator < 0)
3002 	    {
3003 	      sp->speed_control_direction = -1;
3004 	      sp->speed_control_numerator = -sp->speed_control_numerator;
3005 	    }
3006 	  else sp->speed_control_direction = 1;
3007 	  set_speed(sp, fabs(fval));
3008 	  sp->speed_control = fabs(fval); /* not redundant */
3009 	  toggle_direction_arrow(sp, (sp->speed_control_direction == -1));
3010 	  return(val);
3011 	}
3012 #endif
3013       fval = Xen_real_to_C_double(val);
3014       if (fval != 0.0)
3015 	{
3016 	  int direction;
3017 	  if (fval > 0.0) direction = 1; else direction = -1;
3018 	  set_speed(sp, fabs(fval));
3019 #if XEN_HAVE_RATIOS
3020 	  if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
3021 	    snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
3022 #endif
3023 	  toggle_direction_arrow(sp, (direction == -1));
3024 	  if (sp->speed_control_direction == -1)
3025 	    return(C_double_to_Xen_real((-(sp->speed_control))));
3026 	  else return(C_double_to_Xen_real(sp->speed_control));
3027 	}
3028       break;
3029 
3030     case SP_SPEED_BOUNDS:
3031       sp->speed_control_min = Xen_real_to_C_double(Xen_car(val));
3032       sp->speed_control_max = Xen_real_to_C_double(Xen_cadr(val));
3033       set_speed(sp, mus_fclamp(sp->speed_control_min, sp->speed_control, sp->speed_control_max));
3034       return(val);
3035 
3036     case SP_REVERB_LENGTH:
3037       fval = Xen_real_to_C_double(val);
3038       if (fval >= 0.0) set_revlen(sp, fval);
3039       return(C_double_to_Xen_real(sp->reverb_control_length));
3040 
3041     case SP_REVERB_LENGTH_BOUNDS:
3042       sp->reverb_control_length_min = Xen_real_to_C_double(Xen_car(val));
3043       sp->reverb_control_length_max = Xen_real_to_C_double(Xen_cadr(val));
3044       set_revlen(sp, mus_fclamp(sp->reverb_control_length_min, sp->reverb_control_length, sp->reverb_control_length_max));
3045       return(val);
3046 
3047     case SP_REVERB_FEEDBACK:
3048       sp->reverb_control_feedback = mus_fclamp(0.0, Xen_real_to_C_double(val), 100.0);
3049       if (sp->playing) dac_set_reverb_feedback(sp, sp->reverb_control_feedback);
3050       break;
3051 
3052     case SP_REVERB_SCALE:
3053       set_revscl(sp, Xen_real_to_C_double(val));
3054       return(C_double_to_Xen_real(sp->reverb_control_scale));
3055 
3056     case SP_REVERB_SCALE_BOUNDS:
3057       sp->reverb_control_scale_min = Xen_real_to_C_double(Xen_car(val));
3058       sp->reverb_control_scale_max = Xen_real_to_C_double(Xen_cadr(val));
3059       set_revscl(sp, mus_fclamp(sp->reverb_control_scale_min, sp->reverb_control_scale, sp->reverb_control_scale_max));
3060       return(val);
3061 
3062     case SP_REVERB_LOW_PASS:
3063       sp->reverb_control_lowpass = mus_fclamp(0.0, Xen_real_to_C_double(val), 1.0);
3064       if (sp->playing) dac_set_reverb_lowpass(sp, sp->reverb_control_lowpass);
3065       break;
3066 
3067     case SP_REVERB_DECAY:
3068       sp->reverb_control_decay = Xen_real_to_C_double(val);
3069       break;
3070 
3071     case SP_FILTER_ENVELOPE:
3072       {
3073 	env *e = NULL;
3074 	if (sp->filter_control_envelope)
3075 	  sp->filter_control_envelope = free_env(sp->filter_control_envelope);  /* set to null in case get_env throws error */
3076 	if (!(Xen_is_false(val)))
3077 	  e = get_env(val, caller); /* has some error checks -- val must be list, but we can be #f -- see "get" case above: null env (nogui) -> #f */
3078 	if (e)
3079 	  {
3080 	    for (i = 0; i < e->pts; i++)
3081 	      if ((e->data[i * 2 + 1] > 1.0) ||
3082 		  (e->data[i * 2 + 1] < 0.0))
3083 		{
3084 		  free_env(e);
3085 		  Xen_out_of_range_error(caller, 1, val, "y values < 0.0 or > 1.0");
3086 		}
3087 	    sp->filter_control_envelope = e;
3088 	    filter_env_changed(sp, sp->filter_control_envelope);
3089 	  }
3090       }
3091       break;
3092 
3093     default:
3094       break;
3095     }
3096   return(val);
3097 }
3098 
3099 
sound_set_global(Xen snd,Xen val,sp_field_t fld,const char * caller)3100 static Xen sound_set_global(Xen snd, Xen val, sp_field_t fld, const char *caller)
3101 {
3102   mus_float_t fval;
3103   if (!Xen_is_bound(snd))
3104     switch (fld)
3105       {
3106       case SP_FILTER_DBING:
3107 	in_set_filter_control_in_dB(ss, Xen_boolean_to_C_bool(val));
3108 	return(sound_set(Xen_true, val, fld, caller));
3109 
3110       case SP_FILTER_HZING:
3111 	in_set_filter_control_in_hz(ss, Xen_boolean_to_C_bool(val));
3112 	return(sound_set(Xen_true, val, fld, caller));
3113 
3114       case SP_FILTER_ORDER:
3115 	Xen_check_type(Xen_is_integer(val), val, 0, caller, "an integer");
3116 	if (Xen_integer_to_C_int(val) > 0)
3117 	  in_set_filter_control_order(ss, Xen_integer_to_C_int(val));
3118 	return(sound_set(Xen_true, val, fld, caller));
3119 
3120       case SP_SHOW_CONTROLS:
3121 	in_set_show_controls(ss, Xen_boolean_to_C_bool(val));
3122 	return(sound_set(Xen_true, val, fld, caller));
3123 
3124       case SP_SPEED_TONES:
3125 	Xen_check_type(Xen_is_integer(val), val, 0, caller, "an integer");
3126 	in_set_speed_control_tones(ss, Xen_integer_to_C_int(val));
3127 	return(sound_set(Xen_true, val, fld, caller));
3128 
3129       case SP_SPEED_STYLE:
3130 	Xen_check_type(Xen_is_integer(val), val, 0, caller, "an integer");
3131 	in_set_speed_control_style(ss, (speed_style_t)Xen_integer_to_C_int(val)); /* range checked already */
3132 	return(sound_set(Xen_true, val, fld, caller));
3133 
3134       case SP_AMP_BOUNDS:
3135 	in_set_amp_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
3136 	in_set_amp_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
3137 	reflect_mix_change(ANY_MIX_ID);
3138 	return(sound_set(Xen_true, val, fld, caller));
3139 
3140       case SP_CONTRAST_BOUNDS:
3141 	in_set_contrast_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
3142 	in_set_contrast_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
3143 	return(sound_set(Xen_true, val, fld, caller));
3144 
3145       case SP_CONTRAST_AMP:
3146 	in_set_contrast_control_amp(ss, Xen_real_to_C_double(val));
3147 	return(sound_set(Xen_true, val, fld, caller));
3148 
3149       case SP_EXPAND_BOUNDS:
3150 	in_set_expand_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
3151 	in_set_expand_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
3152 	return(sound_set(Xen_true, val, fld, caller));
3153 
3154       case SP_EXPAND_LENGTH:
3155 	fval = Xen_real_to_C_double(val);
3156 	if (fval > 0.0)
3157 	  in_set_expand_control_length(ss, fval);
3158 	return(sound_set(Xen_true, val, fld, caller));
3159 
3160       case SP_EXPAND_RAMP:
3161 	fval = Xen_real_to_C_double(val);
3162 	if ((fval >= 0.0) && (fval < 0.5))
3163 	  in_set_expand_control_ramp(ss, fval);
3164 	return(sound_set(Xen_true, val, fld, caller));
3165 
3166       case SP_EXPAND_HOP:
3167 	fval = Xen_real_to_C_double(val);
3168 	if (fval > 0.0)
3169 	  in_set_expand_control_hop(ss, fval);
3170 	return(sound_set(Xen_true, val, fld, caller));
3171 
3172       case SP_EXPAND_JITTER:
3173 	in_set_expand_control_jitter(ss, Xen_real_to_C_double(val));
3174 	return(sound_set(Xen_true, val, fld, caller));
3175 
3176       case SP_SPEED_BOUNDS:
3177 	in_set_speed_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
3178 	in_set_speed_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
3179 	reflect_mix_change(ANY_MIX_ID);
3180 	return(sound_set(Xen_true, val, fld, caller));
3181 
3182       case SP_REVERB_LENGTH_BOUNDS:
3183 	in_set_reverb_control_length_min(ss, Xen_real_to_C_double(Xen_car(val)));
3184 	in_set_reverb_control_length_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
3185 	return(sound_set(Xen_true, val, fld, caller));
3186 
3187       case SP_REVERB_FEEDBACK:
3188 	in_set_reverb_control_feedback(ss, Xen_real_to_C_double(val));
3189 	return(sound_set(Xen_true, val, fld, caller));
3190 
3191       case SP_REVERB_SCALE_BOUNDS:
3192 	in_set_reverb_control_scale_min(ss, Xen_real_to_C_double(Xen_car(val)));
3193 	in_set_reverb_control_scale_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
3194 	return(sound_set(Xen_true, val, fld, caller));
3195 
3196       case SP_REVERB_LOW_PASS:
3197 	in_set_reverb_control_lowpass(ss, Xen_real_to_C_double(val));
3198 	return(sound_set(Xen_true, val, fld, caller));
3199 
3200       case SP_REVERB_DECAY:
3201 	in_set_reverb_control_decay(ss, Xen_real_to_C_double(val));
3202 	return(sound_set(Xen_true, val, fld, caller));
3203 
3204       default: break;
3205       }
3206   return(sound_set(snd, val, fld, caller));
3207 }
3208 
3209 
g_channels(Xen snd)3210 static Xen g_channels(Xen snd)
3211 {
3212   #define H_channels "("  S_channels " :optional obj): how many channels the object obj has"
3213 
3214   if (Xen_is_string(snd))
3215     return(g_mus_sound_chans(snd));              /* mus-sound-chans */
3216 
3217   if ((mus_is_xen(snd)) ||
3218       (mus_is_vct(snd)) ||
3219       (Xen_is_list(snd)))
3220     return(g_mus_channels(snd));                 /* mus-channels */
3221 
3222   if (xen_is_mix(snd))                            /* mixes are always 1 chan */
3223     return(C_int_to_Xen_integer(1));
3224 
3225   if (xen_is_region(snd))                         /* region-chans */
3226     return(g_region_chans(snd));
3227 
3228   if (xen_is_selection(snd))                      /* selection-chans */
3229     return(g_selection_chans());
3230 
3231   if (Xen_is_vector(snd))                         /* vector as output in clm */
3232     return(C_int_to_Xen_integer(Xen_vector_rank(snd)));
3233 
3234   return(sound_get(snd, SP_NCHANS, S_channels));
3235 }
3236 
3237 
check_number(Xen val,const char * caller)3238 static Xen check_number(Xen val, const char *caller)
3239 {
3240   Xen_check_type(Xen_is_number(val), val, 1, caller, "a number");
3241   return(val);
3242 }
3243 
3244 
check_non_negative_integer(Xen val,const char * caller)3245 static Xen check_non_negative_integer(Xen val, const char *caller)
3246 {
3247   Xen_check_type(Xen_is_integer(val) && (Xen_integer_to_C_int(val) >= 0), val, 1, caller, "a non-negative integer");
3248   return(val);
3249 }
3250 
3251 
g_set_channels(Xen snd,Xen val)3252 static Xen g_set_channels(Xen snd, Xen val)
3253 {
3254   if (!Xen_is_bound(val))
3255     return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_channels), SP_NCHANS, S_set S_channels));
3256   else return(sound_set(snd, check_non_negative_integer(val, S_set S_channels), SP_NCHANS, S_set S_channels));
3257 }
3258 
3259 
g_srate(Xen snd)3260 static Xen g_srate(Xen snd)
3261 {
3262   #define H_srate "(" S_srate " :optional obj): obj's srate; obj can be a region, a string (sound file name), a sound, or an integer (sound index)"
3263 
3264   if (Xen_is_string(snd))
3265     return(g_mus_sound_srate(snd));
3266 
3267   if (xen_is_region(snd))
3268     return(g_region_srate(snd));
3269 
3270   if (xen_is_selection(snd))
3271     return(g_selection_srate());
3272 
3273   return(sound_get(snd, SP_SRATE, S_srate));
3274 }
3275 
3276 
g_set_srate(Xen snd,Xen val)3277 static Xen g_set_srate(Xen snd, Xen val)
3278 {
3279   if (!Xen_is_bound(val))
3280     return(sound_set(Xen_undefined, check_number(snd, S_set S_srate), SP_SRATE, S_set S_srate));
3281   else return(sound_set(snd, check_number(val, S_set S_srate), SP_SRATE, S_set S_srate));
3282 }
3283 
3284 
g_data_location(Xen snd)3285 static Xen g_data_location(Xen snd)
3286 {
3287   #define H_data_location "(" S_data_location " :optional snd): snd's data location (bytes)"
3288   return(sound_get(snd, SP_DATA_LOCATION, S_data_location));
3289 }
3290 
3291 
g_set_data_location(Xen snd,Xen val)3292 static Xen g_set_data_location(Xen snd, Xen val)
3293 {
3294   if (!Xen_is_bound(val))
3295     return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_data_location), SP_DATA_LOCATION, S_set S_data_location));
3296   else return(sound_set(snd, check_non_negative_integer(val, S_set S_data_location), SP_DATA_LOCATION, S_set S_data_location));
3297 }
3298 
3299 
g_data_size(Xen snd)3300 static Xen g_data_size(Xen snd)
3301 {
3302   #define H_data_size "(" S_data_size " :optional snd): snd's data size (bytes)"
3303   return(sound_get(snd, SP_DATA_SIZE, S_data_size));
3304 }
3305 
3306 
g_set_data_size(Xen snd,Xen val)3307 static Xen g_set_data_size(Xen snd, Xen val)
3308 {
3309   if (!Xen_is_bound(val))
3310     return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_data_size), SP_DATA_SIZE, S_set S_data_size));
3311   else return(sound_set(snd, check_non_negative_integer(val, S_set S_data_size), SP_DATA_SIZE, S_set S_data_size));
3312 }
3313 
3314 
g_sample_type(Xen snd)3315 static Xen g_sample_type(Xen snd)
3316 {
3317   #define H_sample_type "(" S_sample_type " :optional snd): snd's sample type (e.g. " S_mus_bshort ")"
3318   return(sound_get(snd, SP_SAMPLE_TYPE, S_sample_type));
3319 }
3320 
3321 
g_set_sample_type(Xen snd,Xen val)3322 static Xen g_set_sample_type(Xen snd, Xen val)
3323 {
3324   if (!Xen_is_bound(val))
3325     return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_sample_type), SP_SAMPLE_TYPE, S_set S_sample_type));
3326   else return(sound_set(snd, check_non_negative_integer(val, S_set S_sample_type), SP_SAMPLE_TYPE, S_set S_sample_type));
3327 }
3328 
3329 
g_header_type(Xen snd)3330 static Xen g_header_type(Xen snd)
3331 {
3332   #define H_header_type "(" S_header_type " :optional snd): snd's header type (e.g. " S_mus_aiff ")"
3333   return(sound_get(snd, SP_HEADER_TYPE, S_header_type));
3334 }
3335 
3336 
g_set_header_type(Xen snd,Xen val)3337 static Xen g_set_header_type(Xen snd, Xen val)
3338 {
3339   if (!Xen_is_bound(val))
3340     return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_header_type), SP_HEADER_TYPE, S_set S_header_type));
3341   else return(sound_set(snd, check_non_negative_integer(val, S_set S_header_type), SP_HEADER_TYPE, S_set S_header_type));
3342 }
3343 
3344 
g_comment(Xen snd)3345 static Xen g_comment(Xen snd)
3346 {
3347   #define H_comment "(" S_comment " :optional snd): snd's comment (in its header)"
3348   return(sound_get(snd, SP_COMMENT, S_comment));
3349 }
3350 
3351 
g_set_comment(Xen snd,Xen val)3352 static Xen g_set_comment(Xen snd, Xen val)
3353 {
3354   if (!Xen_is_bound(val))
3355     {
3356       Xen_check_type(Xen_is_string(snd) || Xen_is_false(snd), snd, 1, S_set S_comment, "a string");
3357       return(sound_set(Xen_undefined, snd, SP_COMMENT, S_set S_comment));
3358     }
3359 
3360   Xen_check_type(Xen_is_string(val) || Xen_is_false(val), val, 2, S_set S_comment, "a string");
3361   return(sound_set(snd, val, SP_COMMENT, S_set S_comment));
3362 }
3363 
3364 
g_sync(Xen snd)3365 static Xen g_sync(Xen snd)
3366 {
3367   #define H_sync "(" S_sync " :optional snd): snd's sync value (0 = no sync).  Some editing operations \
3368 are applied to all sounds sharing the sync value of the selected sound.  'snd' can also be a mix or mark object."
3369 
3370   if (xen_is_mix(snd))                            /* mix-sync */
3371     return(g_mix_sync(snd));
3372 
3373   if (xen_is_mark(snd))                           /* mark-sync */
3374     return(g_mark_sync(snd));
3375 
3376   return(sound_get(snd, SP_SYNC, S_sync));       /* sync */
3377 }
3378 
3379 
g_set_sync(Xen on,Xen snd)3380 static Xen g_set_sync(Xen on, Xen snd)
3381 {
3382   Xen_check_type(Xen_is_integer_or_boolean(on), on, 1, S_set S_sync, "an integer");
3383 
3384   if (xen_is_mix(snd))
3385     return(g_set_mix_sync(snd, on));
3386 
3387   if (xen_is_mark(snd))
3388     return(g_set_mark_sync(snd, on));
3389 
3390   return(sound_set(snd, on, SP_SYNC, S_set S_sync));
3391 }
3392 
with_two_setter_args(g_set_sync_reversed,g_set_sync)3393 with_two_setter_args(g_set_sync_reversed, g_set_sync)
3394 
3395 
3396 static Xen g_sync_max(void)
3397 {
3398   #define H_sync_max "(" S_sync_max "): max sound sync value seen so far"
3399   return(C_int_to_Xen_integer(ss->sound_sync_max));
3400 }
3401 
3402 
g_sound_properties(Xen snd)3403 static Xen g_sound_properties(Xen snd)
3404 {
3405   #define H_sound_properties "(" S_sound_properties " :optional snd): snd's property list"
3406   return(sound_get(snd, SP_PROPERTIES, S_sound_properties));
3407 }
3408 
3409 
g_set_sound_properties(Xen on,Xen snd)3410 static Xen g_set_sound_properties(Xen on, Xen snd)
3411 {
3412   return(sound_set(snd, on, SP_PROPERTIES, S_set S_sound_properties));
3413 }
3414 
with_two_setter_args(g_set_sound_properties_reversed,g_set_sound_properties)3415 with_two_setter_args(g_set_sound_properties_reversed, g_set_sound_properties)
3416 
3417 
3418 static Xen g_sound_property(Xen key, Xen snd)
3419 {
3420   #define H_sound_property "(" S_sound_property " key snd) returns the value associated with 'key' in the given sound's\
3421 property list, or " PROC_FALSE "."
3422   return(Xen_assoc_ref(key, g_sound_properties(snd)));
3423 }
3424 
3425 #if HAVE_SCHEME
g_set_sound_property(Xen val,Xen key,Xen snd)3426 static Xen g_set_sound_property(Xen val, Xen key, Xen snd)
3427 #else
3428 static Xen g_set_sound_property(Xen key, Xen val, Xen snd)
3429 #endif
3430 {
3431   g_set_sound_properties(Xen_assoc_set(key, val, g_sound_properties(snd)), snd);
3432   return(val);
3433 }
3434 
with_three_setter_args(g_set_sound_property_reversed,g_set_sound_property)3435 with_three_setter_args(g_set_sound_property_reversed, g_set_sound_property)
3436 
3437 
3438 
3439 static Xen g_channel_style(Xen snd)
3440 {
3441   snd_info *sp;
3442 
3443   if (!Xen_is_bound(snd))
3444     return(C_int_to_Xen_integer(channel_style(ss)));
3445 
3446   Snd_assert_sound(S_channel_style, snd, 1);
3447   sp = get_sp(snd);
3448   if (!sp)
3449     return(snd_no_such_sound_error(S_channel_style, snd));
3450 
3451   return(C_int_to_Xen_integer((int)(sp->channel_style)));
3452 }
3453 
3454 
update_sound(snd_info * sp)3455 static void update_sound(snd_info *sp)
3456 {
3457   if (sp)
3458     {
3459       switch (channel_style(ss))
3460 	{
3461 	case CHANNELS_SEPARATE:     separate_sound(sp);    break;
3462 	case CHANNELS_COMBINED:     combine_sound(sp);     break;
3463 	case CHANNELS_SUPERIMPOSED: superimpose_sound(sp); break;
3464 	default:
3465 	  break;
3466 	}
3467     }
3468 }
3469 
3470 
set_channel_style(channel_style_t val)3471 void set_channel_style(channel_style_t val)
3472 {
3473   in_set_channel_style(val);
3474   for_each_sound(update_sound);
3475   for_each_chan(update_graph);
3476 }
3477 
3478 
g_set_channel_style(Xen style,Xen snd)3479 static Xen g_set_channel_style(Xen style, Xen snd)
3480 {
3481   snd_info *sp;
3482   int in_style;
3483   channel_style_t new_style = CHANNELS_SEPARATE;
3484 
3485   #define H_channel_style "(" S_channel_style " :optional snd): how multichannel sounds lay out the channels. \
3486 The default is " S_channels_combined "; other values are " S_channels_separate " and " S_channels_superimposed ". \
3487 As a global (if the 'snd' arg is omitted), it is the default setting for each sound's 'unite' button."
3488 
3489   Xen_check_type(Xen_is_integer(style), style, 1, S_set S_channel_style, "an integer");
3490   in_style = Xen_integer_to_C_int(style);
3491   if ((in_style < 0) ||
3492       (in_style >= NUM_CHANNEL_STYLES))
3493     Xen_out_of_range_error(S_set S_channel_style, 1, style, S_channel_style " should be " S_channels_separate ", " S_channels_combined ", or " S_channels_superimposed);
3494   new_style = (channel_style_t)in_style;
3495 
3496   if (!Xen_is_bound(snd))
3497     {
3498       set_channel_style(new_style);
3499       return(C_int_to_Xen_integer(channel_style(ss)));
3500     }
3501 
3502   Snd_assert_sound(S_set S_channel_style, snd, 2);
3503   sp = get_sp(snd);
3504   if (!sp)
3505     return(snd_no_such_sound_error(S_set S_channel_style, snd));
3506 
3507   set_sound_channel_style(sp, new_style);
3508 
3509   return(C_int_to_Xen_integer((int)(sp->channel_style)));
3510 }
3511 
with_two_setter_args(g_set_channel_style_reversed,g_set_channel_style)3512 with_two_setter_args(g_set_channel_style_reversed, g_set_channel_style)
3513 
3514 
3515 static Xen g_read_only(Xen snd)
3516 {
3517   #define H_read_only "(" S_read_only " :optional snd): whether snd is write-protected"
3518   return(sound_get(snd, SP_READ_ONLY, S_read_only));
3519 }
3520 
3521 
g_set_read_only(Xen on,Xen snd)3522 static Xen g_set_read_only(Xen on, Xen snd)
3523 {
3524   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_read_only, "a boolean");
3525   return(sound_set(snd, on, SP_READ_ONLY, S_set S_read_only));
3526 }
3527 
with_two_setter_args(g_set_read_only_reversed,g_set_read_only)3528 with_two_setter_args(g_set_read_only_reversed, g_set_read_only)
3529 
3530 
3531 static Xen g_contrast_control_on(Xen snd)
3532 {
3533   #define H_contrast_control_on "(" S_contrast_control_on " :optional snd): snd's control panel contrast button state"
3534   return(sound_get(snd, SP_CONTRASTING, S_contrast_control_on));
3535 }
3536 
3537 
g_set_contrast_control_on(Xen on,Xen snd)3538 static Xen g_set_contrast_control_on(Xen on, Xen snd)
3539 {
3540   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_contrast_control_on, "a boolean");
3541   return(sound_set(snd, on, SP_CONTRASTING, S_set S_contrast_control_on));
3542 }
3543 
with_two_setter_args(g_set_contrast_control_on_reversed,g_set_contrast_control_on)3544 with_two_setter_args(g_set_contrast_control_on_reversed, g_set_contrast_control_on)
3545 
3546 
3547 static Xen g_expand_control_on(Xen snd)
3548 {
3549   #define H_expand_control_on "(" S_expand_control_on " :optional snd): snd's control panel expand button state"
3550   return(sound_get(snd, SP_EXPANDING, S_expand_control_on));
3551 }
3552 
3553 
g_set_expand_control_on(Xen on,Xen snd)3554 static Xen g_set_expand_control_on(Xen on, Xen snd)
3555 {
3556   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_expand_control_on, "a boolean");
3557   return(sound_set(snd, on, SP_EXPANDING, S_set S_expand_control_on));
3558 }
3559 
with_two_setter_args(g_set_expand_control_on_reversed,g_set_expand_control_on)3560 with_two_setter_args(g_set_expand_control_on_reversed, g_set_expand_control_on)
3561 
3562 
3563 static Xen g_reverb_control_on(Xen snd)
3564 {
3565   #define H_reverb_control_on "(" S_reverb_control_on " :optional snd): snd's control panel reverb button state"
3566   return(sound_get(snd, SP_REVERBING, S_reverb_control_on));
3567 }
3568 
3569 
g_set_reverb_control_on(Xen on,Xen snd)3570 static Xen g_set_reverb_control_on(Xen on, Xen snd)
3571 {
3572   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_reverb_control_on, "a boolean");
3573   return(sound_set(snd, on, SP_REVERBING, S_set S_reverb_control_on));
3574 }
3575 
with_two_setter_args(g_set_reverb_control_on_reversed,g_set_reverb_control_on)3576 with_two_setter_args(g_set_reverb_control_on_reversed, g_set_reverb_control_on)
3577 
3578 
3579 static Xen g_filter_control_on(Xen snd)
3580 {
3581   #define H_filter_control_on "(" S_filter_control_on " :optional snd): snd's control panel filter button state"
3582   return(sound_get(snd, SP_FILTERING, S_filter_control_on));
3583 }
3584 
3585 
g_set_filter_control_on(Xen on,Xen snd)3586 static Xen g_set_filter_control_on(Xen on, Xen snd)
3587 {
3588   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_filter_control_on, "a boolean");
3589   return(sound_set(snd, on, SP_FILTERING, S_set S_filter_control_on));
3590 }
3591 
with_two_setter_args(g_set_filter_control_on_reversed,g_set_filter_control_on)3592 with_two_setter_args(g_set_filter_control_on_reversed, g_set_filter_control_on)
3593 
3594 
3595 static Xen g_filter_control_in_dB(Xen snd)
3596 {
3597   #define H_filter_control_in_dB "(" S_filter_control_in_dB " :optional snd): " PROC_TRUE " if snd's filter envelope is displayed in dB in control panel"
3598   return(sound_get_global(snd, SP_FILTER_DBING, S_filter_control_in_dB));
3599 }
3600 
3601 
g_set_filter_control_in_dB(Xen on,Xen snd)3602 static Xen g_set_filter_control_in_dB(Xen on, Xen snd)
3603 {
3604   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_filter_control_in_dB, "a boolean");
3605   return(sound_set_global(snd, on, SP_FILTER_DBING, S_set S_filter_control_in_dB));
3606 }
3607 
with_two_setter_args(g_set_filter_control_in_dB_reversed,g_set_filter_control_in_dB)3608 with_two_setter_args(g_set_filter_control_in_dB_reversed, g_set_filter_control_in_dB)
3609 
3610 
3611 static Xen g_filter_control_in_hz(Xen snd)
3612 {
3613   #define H_filter_control_in_hz "(" S_filter_control_in_hz " :optional snd): " PROC_TRUE " if snd's filter envelope x axis should be in hz (control panel filter)"
3614   return(sound_get_global(snd, SP_FILTER_HZING, S_filter_control_in_hz));
3615 }
3616 
3617 
g_set_filter_control_in_hz(Xen on,Xen snd)3618 static Xen g_set_filter_control_in_hz(Xen on, Xen snd)
3619 {
3620   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_filter_control_in_hz, "a boolean");
3621   return(sound_set_global(snd, on, SP_FILTER_HZING, S_set S_filter_control_in_hz));
3622 }
3623 
with_two_setter_args(g_set_filter_control_in_hz_reversed,g_set_filter_control_in_hz)3624 with_two_setter_args(g_set_filter_control_in_hz_reversed, g_set_filter_control_in_hz)
3625 
3626 
3627 static Xen g_filter_control_coeffs(Xen snd)
3628 {
3629   #define H_filter_control_coeffs "(" S_filter_control_coeffs " :optional snd): control panel filter coeffs"
3630   return(sound_get(snd, SP_FILTER_COEFFS, S_filter_control_coeffs));
3631 }
3632 
3633 
g_filter_control_order(Xen snd)3634 static Xen g_filter_control_order(Xen snd)
3635 {
3636   #define H_filter_control_order "(" S_filter_control_order " :optional snd): filter order (in control panel)"
3637   return(sound_get_global(snd, SP_FILTER_ORDER, S_filter_control_order));
3638 }
3639 
3640 
g_set_filter_control_order(Xen on,Xen snd)3641 static Xen g_set_filter_control_order(Xen on, Xen snd)
3642 {
3643   Xen_check_type(Xen_is_integer(on), on, 1, S_set S_filter_control_order, "an integer");
3644   return(sound_set_global(snd, on, SP_FILTER_ORDER, S_set S_filter_control_order));
3645 }
3646 
with_two_setter_args(g_set_filter_control_order_reversed,g_set_filter_control_order)3647 with_two_setter_args(g_set_filter_control_order_reversed, g_set_filter_control_order)
3648 
3649 
3650 static Xen g_show_controls(Xen snd)
3651 {
3652   #define H_show_controls "(" S_show_controls " :optional snd): " PROC_TRUE " if snd's control panel is known to be open"
3653   return(sound_get_global(snd, SP_SHOW_CONTROLS, S_show_controls));
3654 }
3655 
3656 
g_set_show_controls(Xen on,Xen snd)3657 static Xen g_set_show_controls(Xen on, Xen snd)
3658 {
3659   Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_show_controls, "a boolean");
3660   return(sound_set_global(snd, on, SP_SHOW_CONTROLS, S_set S_show_controls));
3661 }
3662 
with_two_setter_args(g_set_show_controls_reversed,g_set_show_controls)3663 with_two_setter_args(g_set_show_controls_reversed, g_set_show_controls)
3664 
3665 
3666 static Xen g_save_controls(Xen snd)
3667 {
3668   #define H_save_controls "(" S_save_controls " :optional snd): save the control panel settings for subsequent " S_restore_controls
3669   return(sound_get(snd, SP_SAVE_CONTROLS, S_save_controls));
3670 }
3671 
3672 
g_restore_controls(Xen snd)3673 static Xen g_restore_controls(Xen snd)
3674 {
3675   #define H_restore_controls "(" S_restore_controls " :optional snd): restore the previously saved control panel settings"
3676   return(sound_get(snd, SP_RESTORE_CONTROLS, S_restore_controls));
3677 }
3678 
3679 
g_reset_controls(Xen snd)3680 static Xen g_reset_controls(Xen snd)
3681 {
3682   #define H_reset_controls "(" S_reset_controls " :optional snd): reset (clear) the control panel settings"
3683   return(sound_get(snd, SP_RESET_CONTROLS, S_reset_controls));
3684 }
3685 
3686 
g_selected_channel(Xen snd)3687 static Xen g_selected_channel(Xen snd)
3688 {
3689   #define H_selected_channel "(" S_selected_channel " :optional snd): currently selected channel in snd (or " PROC_FALSE " if none)"
3690   return(sound_get(snd, SP_SELECTED_CHANNEL, S_selected_channel));
3691 }
3692 
3693 
g_set_selected_channel(Xen snd,Xen chn_n)3694 static Xen g_set_selected_channel(Xen snd, Xen chn_n)
3695 {
3696   snd_info *sp;
3697 
3698   if (!Xen_is_bound(chn_n))
3699     return(g_select_channel(snd));
3700 
3701   Snd_assert_sound(S_set S_selected_channel, snd, 1);
3702   sp = get_sp(snd);
3703   if (!sp)
3704     return(snd_no_such_sound_error(S_set S_selected_channel, snd));
3705 
3706   if (Xen_is_false(chn_n))
3707     sp->selected_channel = NO_SELECTION;
3708   else
3709     {
3710       mus_long_t chan = 0;
3711       if (Xen_is_integer(chn_n)) chan = Xen_integer_to_C_int(chn_n);
3712       if ((chan >= 0) &&
3713 	  (chan < (int)sp->nchans))
3714 	{
3715 	  select_channel(sp, (int)chan);
3716 	  return(chn_n);
3717 	}
3718       return(snd_no_such_channel_error(S_set S_selected_channel, snd, chn_n));
3719     }
3720 
3721   return(Xen_false);
3722 }
3723 
3724 
g_file_name(Xen snd)3725 static Xen g_file_name(Xen snd)
3726 {
3727   #define H_file_name "(" S_file_name " :optional snd): snd's full filename; snd can be a sound, mix, region, string, or generator."
3728 
3729   if (xen_is_sound(snd))
3730     return(sound_get(snd, SP_FILE_NAME, S_file_name));
3731 
3732   if (mus_is_xen(snd))
3733     return(g_mus_file_name(snd));
3734 
3735   if (xen_is_mix(snd))
3736     return(C_string_to_Xen_string(mix_file_name(Xen_mix_to_C_int(snd))));
3737 
3738   if (xen_is_region(snd))
3739     return(C_string_to_Xen_string(region_file_name(Xen_region_to_C_int(snd))));
3740 
3741 #if HAVE_SCHEME
3742   if ((s7_is_input_port(s7, snd)) || (s7_is_output_port(s7, snd)))
3743     return(C_string_to_Xen_string(s7_port_filename(s7, snd)));
3744 #endif
3745 
3746   if (Xen_is_string(snd))
3747     return(g_mus_expand_filename(snd));
3748 
3749   if ((is_sampler(snd)) || (is_mix_sampler(snd)))
3750     return(g_sampler_file_name(snd));
3751 
3752   return(sound_get(snd, SP_FILE_NAME, S_file_name));
3753 }
3754 
3755 
g_short_file_name(Xen snd)3756 static Xen g_short_file_name(Xen snd)
3757 {
3758   #define H_short_file_name "(" S_short_file_name " :optional snd): short form of snd's file name (no directory)"
3759   return(sound_get(snd, SP_SHORT_FILE_NAME, S_short_file_name));
3760 }
3761 
3762 
g_close_sound_1(int snd)3763 static Xen g_close_sound_1(int snd)
3764 {
3765   if ((snd >= 0) &&
3766       (snd < ss->max_sounds))
3767     {
3768       snd_info *sp;
3769       sp = ss->sounds[snd];
3770       if (snd_ok(sp))
3771 	{
3772 	  if (sp->inuse == SOUND_WRAPPER) /* from make_simple_channel_display (variable-graph and the region graphs) */
3773 	    {
3774 	      /* not sure what to do in this case, but at least we can get it out of the various #t chan loops */
3775 	      sp->inuse = SOUND_IDLE;
3776 	      ss->sounds[sp->index] = NULL; /* a huge memory leak... */
3777 	    }
3778 	  else snd_close_file(sp);
3779 	}
3780     }
3781   return(Xen_false);
3782 }
3783 
3784 
g_close_sound(Xen snd)3785 static Xen g_close_sound(Xen snd)
3786 {
3787   #define H_close_sound "(" S_close_sound " :optional snd): close snd"
3788 
3789   if (Xen_is_integer(snd))
3790     return(g_close_sound_1(Xen_integer_to_C_int(snd)));
3791 
3792   if (xen_is_sound(snd))
3793     return(g_close_sound_1(Xen_sound_to_C_int(snd)));
3794 
3795   return(sound_get(snd, SP_CLOSE, S_close_sound));
3796 }
3797 
3798 
g_update_sound(Xen snd)3799 static Xen g_update_sound(Xen snd)
3800 {
3801   #define H_update_sound "(" S_update_sound " :optional snd): update snd (re-read it from the disk after flushing pending edits)"
3802   return(sound_get(snd, SP_UPDATE, S_update_sound));
3803 }
3804 
3805 
save_sound_error_handler(const char * msg,void * data)3806 static void save_sound_error_handler(const char *msg, void *data)
3807 {
3808   redirect_snd_error_to(NULL, NULL);
3809   redirect_snd_warning_to(NULL, NULL);
3810   Xen_error(Xen_make_error_type("cannot-save"),
3811 	    Xen_list_3(C_string_to_Xen_string("~A: ~A"),
3812 		       C_string_to_Xen_string((char *)data),
3813 		       C_string_to_Xen_string(msg)));
3814 }
3815 
3816 
g_save_sound(Xen index)3817 static Xen g_save_sound(Xen index)
3818 {
3819   snd_info *sp;
3820   io_error_t err = IO_NO_ERROR;
3821   #define H_save_sound "(" S_save_sound " :optional snd): save snd (update the on-disk data to match Snd's current version)"
3822 
3823   Snd_assert_sound(S_save_sound, index, 1);
3824 
3825   sp = get_sp(index);
3826   if (!sp)
3827     return(snd_no_such_sound_error(S_save_sound, index));
3828 
3829   if ((sp->user_read_only == FILE_READ_ONLY) ||
3830       (sp->file_read_only == FILE_READ_ONLY))
3831     {
3832       char *msg;
3833       Xen str;
3834       msg = mus_format("%s (index %d) is write-protected",
3835 		       sp->short_filename,
3836 		       sp->index);
3837       str = C_string_to_Xen_string(msg);
3838       free(msg);
3839       Xen_error(Xen_make_error_type("cannot-save"),
3840 		Xen_list_2(C_string_to_Xen_string(S_save_sound ": can't save sound, ~A"),
3841 			   str));
3842       return(Xen_false);
3843     }
3844 
3845   redirect_snd_error_to(save_sound_error_handler, (void *)S_save_sound);
3846   redirect_snd_warning_to(save_sound_error_handler, (void *)S_save_sound);
3847   err = save_edits_without_asking(sp);
3848   redirect_snd_error_to(NULL, NULL);
3849   redirect_snd_warning_to(NULL, NULL);
3850 
3851   /* if err and we got here, report it */
3852   if (is_serious_io_error(err))
3853     Xen_error(Xen_make_error_type("cannot-save"),
3854 	      Xen_list_2(C_string_to_Xen_string(S_save_sound ": IO error ~A"),
3855 			 C_string_to_Xen_string(io_error_name(err))));
3856 
3857   return(C_int_to_Xen_sound(sp->index));
3858 }
3859 
3860 
g_revert_sound(Xen index)3861 static Xen g_revert_sound(Xen index)
3862 {
3863   #define H_revert_sound "("  S_revert_sound " :optional snd): revert snd to its unedited state (undo all)"
3864   snd_info *sp;
3865   uint32_t i;
3866 
3867   Snd_assert_sound(S_revert_sound, index, 1);
3868 
3869   sp = get_sp(index);
3870   if (!sp)
3871     return(snd_no_such_sound_error(S_revert_sound, index));
3872 
3873   for (i = 0; i < sp->nchans; i++)
3874     {
3875       revert_edits(sp->chans[i]);
3876       update_graph(sp->chans[i]);
3877     }
3878   reflect_file_revert_in_label(sp);
3879 
3880   return(index); /* was #t */
3881 }
3882 
3883 
g_selected_sound(void)3884 static Xen g_selected_sound(void)
3885 {
3886   #define H_selected_sound "(" S_selected_sound "): currently selected sound (or " PROC_FALSE " if none)"
3887   if ((ss->selected_sound != NO_SELECTION) &&
3888       (snd_ok(ss->sounds[ss->selected_sound])))
3889     return(C_int_to_Xen_sound(ss->selected_sound));
3890 
3891   return(Xen_false);
3892 }
3893 
3894 
open_sound_error_handler(const char * msg,void * data)3895 static void open_sound_error_handler(const char *msg, void *data)
3896 {
3897   redirect_snd_error_to(NULL, NULL);
3898   redirect_snd_warning_to(NULL, NULL);
3899   Xen_error(Xen_make_error_type("not-a-sound-file"),
3900 	    Xen_list_3(C_string_to_Xen_string("~A: ~A"),
3901 		       C_string_to_Xen_string((char *)data),
3902 		       C_string_to_Xen_string(msg)));
3903 }
3904 
3905 
g_open_sound(Xen filename)3906 static Xen g_open_sound(Xen filename)
3907 {
3908   /* return new sound if successful */
3909   #define H_open_sound "(" S_open_sound " filename): \
3910 open filename (as if opened from File:Open menu option), and return the new sound"
3911 
3912   const char *fname = NULL;
3913   snd_info *sp;
3914   bool file_exists;
3915 
3916   Xen_check_type(Xen_is_string(filename), filename, 1, S_open_sound, "a string");
3917 
3918   fname = Xen_string_to_C_string(filename);
3919   {
3920     char *fullname;
3921     /* before probing, need to undo all the Unix-isms */
3922     fullname = mus_expand_filename(fname);
3923     file_exists = mus_file_probe(fullname);
3924     free(fullname);
3925   }
3926 
3927   if (!file_exists)
3928     return(snd_no_such_file_error(S_open_sound, filename));
3929   ss->open_requestor = FROM_OPEN_SOUND;
3930 
3931   redirect_snd_error_to(open_sound_error_handler, (void *)S_open_sound);
3932   sp = snd_open_file(fname, FILE_READ_WRITE); /* this will call mus_expand_filename */
3933   redirect_snd_error_to(NULL, NULL);
3934 
3935   if (sp)
3936     return(C_int_to_Xen_sound(sp->index));
3937 
3938   /* sp NULL is not an error (open-hook func returned #t) */
3939   return(Xen_false);
3940 }
3941 
3942 #if (!HAVE_SCHEME)
3943 static Xen kw_header_type, kw_file, kw_srate, kw_channel, kw_sound, kw_edit_position, kw_channels, kw_size, kw_comment, kw_sample_type;
3944 
init_sound_keywords(void)3945 static void init_sound_keywords(void)
3946 {
3947   kw_header_type = Xen_make_keyword("header-type");
3948   kw_sample_type = Xen_make_keyword("sample-type");
3949   kw_file = Xen_make_keyword("file");
3950   kw_srate = Xen_make_keyword("srate");
3951   kw_channel = Xen_make_keyword("channel");
3952   kw_sound = Xen_make_keyword("sound");
3953   kw_edit_position = Xen_make_keyword("edit-position");
3954   kw_channels = Xen_make_keyword("channels");
3955   kw_size = Xen_make_keyword("size");
3956   kw_comment = Xen_make_keyword("comment");
3957 }
3958 #endif
3959 
3960 #define H_open_raw_sound "(" S_open_raw_sound " file channels srate sample-type): \
3961 open file assuming the data matches the attributes indicated unless the file actually has a header"
3962 
3963 #if HAVE_SCHEME
g_open_raw_sound(s7_scheme * sc,s7_pointer args)3964 static s7_pointer g_open_raw_sound(s7_scheme *sc, s7_pointer args)
3965 {
3966   const char *file;
3967   char *fullname;
3968   snd_info *sp;
3969   bool file_exists;
3970   int os = 1, oc = 1;
3971   mus_sample_t ofr = MUS_BSHORT;
3972   s7_pointer p, fp;
3973 
3974   mus_header_raw_defaults(&os, &oc, &ofr);
3975 
3976   fp = s7_car(args);
3977   if (!s7_is_string(fp))
3978     Xen_error(NO_SUCH_FILE,
3979 	      Xen_list_1(C_string_to_Xen_string(S_open_raw_sound ": no output file?")));
3980   file = s7_string(fp);
3981   fullname = mus_expand_filename(file);
3982   file_exists = mus_file_probe(fullname);
3983   free(fullname);
3984   if (!file_exists)
3985     return(snd_no_such_file_error(S_open_raw_sound, fp));
3986 
3987   fp = s7_cadr(args);
3988   if (fp != Xen_false)
3989     {
3990       if (!s7_is_integer(fp))
3991 	return(s7_wrong_type_arg_error(sc, S_open_raw_sound, 2, fp, "an integer"));
3992       oc = s7_integer(fp);
3993       if ((oc < 0) ||
3994 	  (oc > MUS_MAX_CHANS))
3995 	Xen_out_of_range_error(S_open_raw_sound, 2, fp, "too many channels requested");
3996       set_fallback_chans(oc);
3997     }
3998 
3999   p = s7_cddr(args);
4000 
4001   fp = s7_car(p);
4002   if (fp != Xen_false)
4003     {
4004       if (!s7_is_integer(fp))
4005 	return(s7_wrong_type_arg_error(sc, S_open_raw_sound, 3, fp, "an integer"));
4006       os = s7_integer(fp);
4007       set_fallback_srate(os);
4008     }
4009 
4010   fp = s7_cadr(p);
4011   if (fp != Xen_false)
4012     {
4013       if (!s7_is_integer(fp))
4014 	return(s7_wrong_type_arg_error(sc, S_open_raw_sound, 4, fp, "an integer"));
4015       ofr = (mus_sample_t)s7_integer(fp);
4016       set_fallback_sample_type(ofr);
4017     }
4018 
4019   mus_header_set_raw_defaults(os, oc, ofr);
4020   ss->reloading_updated_file = -1;
4021   ss->open_requestor = FROM_OPEN_RAW_SOUND;
4022   sp = snd_open_file(file, FILE_READ_WRITE);
4023   set_fallback_chans(0);
4024   set_fallback_srate(0);
4025   set_fallback_sample_type(MUS_UNKNOWN_SAMPLE);
4026   ss->reloading_updated_file = 0;
4027   if (sp)
4028     return(C_int_to_Xen_sound(sp->index));
4029   return(Xen_false);
4030 }
4031 #else
g_open_raw_sound(Xen arglist)4032 static Xen g_open_raw_sound(Xen arglist)
4033 {
4034   const char *file = NULL;
4035   char *fullname;
4036   snd_info *sp;
4037   bool file_exists;
4038   int os = 1, oc = 1;
4039   mus_sample_t ofr = MUS_BSHORT;
4040   Xen args[8];
4041   Xen keys[4];
4042   int orig_arg[4] = {0, 0, 0, 0};
4043   int vals, i, arglist_len;
4044 
4045   keys[0] = kw_file;
4046   keys[1] = kw_channels;
4047   keys[2] = kw_srate;
4048   keys[3] = kw_sample_type;
4049 
4050   mus_header_raw_defaults(&os, &oc, &ofr);
4051 
4052   for (i = 0; i < 8; i++) args[i] = Xen_undefined;
4053   arglist_len = Xen_list_length(arglist);
4054   if (arglist_len > 8)
4055     Xen_out_of_range_error(S_open_raw_sound, 0, arglist, "too many arguments");
4056 
4057   for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
4058   vals = mus_optkey_unscramble(S_open_raw_sound, arglist_len, 4, keys, args, orig_arg);
4059 
4060   if (vals > 0)
4061     {
4062       file = mus_optkey_to_string(keys[0], S_open_raw_sound, orig_arg[0], NULL);
4063       oc = mus_optkey_to_int(keys[1], S_open_raw_sound, orig_arg[1], oc);
4064       if ((oc < 0) ||
4065 	  (oc > MUS_MAX_CHANS))
4066 	Xen_out_of_range_error(S_open_raw_sound, 2, args[orig_arg[1]], "too many channels requested");
4067       if (!(Xen_is_keyword(keys[1]))) set_fallback_chans(oc);
4068       os = mus_optkey_to_int(keys[2], S_open_raw_sound, orig_arg[2], os);
4069       if (!(Xen_is_keyword(keys[2]))) set_fallback_srate(os);
4070       ofr = (mus_sample_t)mus_optkey_to_int(keys[3], S_open_raw_sound, orig_arg[3], (int)ofr);
4071       if (!(Xen_is_keyword(keys[3]))) set_fallback_sample_type(ofr);
4072     }
4073 
4074   if (!file)
4075     Xen_error(NO_SUCH_FILE,
4076 	      Xen_list_1(C_string_to_Xen_string(S_open_raw_sound ": no output file?")));
4077 
4078   fullname = mus_expand_filename(file);
4079   file_exists = mus_file_probe(fullname);
4080   free(fullname);
4081   if (!file_exists)
4082     return(snd_no_such_file_error(S_open_raw_sound, keys[0]));
4083 
4084   mus_header_set_raw_defaults(os, oc, ofr);
4085   ss->reloading_updated_file = -1;
4086   ss->open_requestor = FROM_OPEN_RAW_SOUND;
4087 
4088   sp = snd_open_file(file, FILE_READ_WRITE);
4089 
4090   set_fallback_chans(0);
4091   set_fallback_srate(0);
4092   set_fallback_sample_type(MUS_UNKNOWN_SAMPLE);
4093   ss->reloading_updated_file = 0;
4094 
4095   /* snd_open_file -> snd_open_file_1 -> add_sound_window -> make_file_info -> raw_data_dialog_to_file_info */
4096   /*   so here if hooked, we'd need to save the current hook, make it return the current args, open, then restore */
4097 
4098   if (sp)
4099     return(C_int_to_Xen_sound(sp->index));
4100   return(Xen_false);
4101 }
4102 #endif
4103 
4104 #if HAVE_SCHEME
4105   #define read_only_example "You can make it writable via: (set! (" S_read_only ") #f)"
4106 #endif
4107 #if HAVE_RUBY
4108   #define read_only_example "You can make it writable via: set_read_only(false)"
4109 #endif
4110 #if HAVE_FORTH
4111   #define read_only_example "You can make it writable via: #f set-read-only"
4112 #endif
4113 
g_view_sound(Xen filename)4114 static Xen g_view_sound(Xen filename)
4115 {
4116   #define H_view_sound "(" S_view_sound " filename): open a file in read-only mode. " read_only_example " at any time."
4117 
4118   const char *fname = NULL;
4119   char *fullname;
4120   snd_info *sp = NULL;
4121   bool file_exists;
4122 
4123   Xen_check_type(Xen_is_string(filename), filename, 1, S_view_sound, "a string");
4124 
4125   fname = Xen_string_to_C_string(filename);
4126   fullname = mus_expand_filename(fname);
4127   file_exists = mus_file_probe(fullname);
4128   free(fullname);
4129   if (!file_exists)
4130     return(snd_no_such_file_error(S_view_sound, filename));
4131 
4132   ss->open_requestor = FROM_VIEW_SOUND;
4133   sp = snd_open_file(fname, FILE_READ_ONLY);
4134 
4135   if (sp)
4136     return(C_int_to_Xen_sound(sp->index));
4137   return(Xen_false);
4138 }
4139 
4140   #if HAVE_SCHEME
4141     #define save_as_example "(" S_save_sound_as " \"test.snd\" index 44100 " S_mus_bshort " " S_mus_next ")"
4142   #endif
4143   #if HAVE_RUBY
4144     #define save_as_example "save_sound_as(\"test.snd\", index, 44100, Mus_bshort, Mus_next)"
4145   #endif
4146   #if HAVE_FORTH
4147     #define save_as_example "\"test.snd\" index 44100 mus-bshort mus-next save-sound-as"
4148   #endif
4149 
4150   #define H_save_sound_as "("  S_save_sound_as " file sound srate sample-type header-type channel edit-position comment): \
4151 save sound in file using the indicated attributes.  If channel is specified, only that channel is saved (extracted). \
4152 Omitted arguments take their value from the sound being saved.\n  " save_as_example
4153 
4154 #if HAVE_SCHEME
g_save_sound_as(s7_scheme * sc,s7_pointer args)4155 static s7_pointer g_save_sound_as(s7_scheme *sc, s7_pointer args)
4156 {
4157   snd_info *sp = NULL;
4158   file_info *hdr;
4159   mus_header_t ht;
4160   mus_sample_t df;
4161   char *fname = NULL;
4162   int sr, chan;
4163   const char *outcom, *file;
4164   io_error_t io_err = IO_NO_ERROR;
4165   s7_pointer p, fp, index, edpos, pchan, filep;
4166   bool free_outcom = false;
4167   int edit_position = AT_CURRENT_EDIT_POSITION;
4168 
4169   /* fprintf(stderr, "args: %s\n", s7_object_to_c_string(sc, args)); */
4170 
4171   fp = s7_car(args);
4172   filep = fp;
4173   if (fp != Xen_false)
4174     {
4175       if (!s7_is_string(fp))
4176 	return(s7_wrong_type_arg_error(sc, S_save_sound_as, 1, fp, "a string (a filename)"));
4177       file = s7_string(fp);
4178     }
4179   else file = NULL;
4180 
4181   index = s7_cadr(args);
4182   Snd_assert_sound(S_save_sound_as, index, 2);
4183   sp = get_sp(index);
4184   if (!sp)
4185     return(snd_no_such_sound_error(S_save_sound_as, index));
4186   hdr = sp->hdr;
4187 
4188   p = s7_cddr(args);
4189   fp = s7_car(p);
4190   if (fp != Xen_false)
4191     {
4192       if (!s7_is_integer(fp))
4193 	return(s7_wrong_type_arg_error(sc, S_save_sound_as, 3, fp, "an integer (srate)"));
4194       sr = s7_integer(fp);
4195       if (sr <= 0)
4196 	Xen_error(Xen_make_error_type("cannot-save"),
4197 		  Xen_list_2(C_string_to_Xen_string(S_save_sound_as ": srate (~A) can't be <= 0"), fp));
4198     }
4199   else sr = -1;
4200 
4201   fp = s7_cadr(p);
4202   if (fp != Xen_false)
4203     {
4204       if (!s7_is_integer(fp))
4205 	return(s7_wrong_type_arg_error(sc, S_save_sound_as, 4, fp, "an integer (sample type)"));
4206       df = (mus_sample_t)s7_integer(fp);
4207     }
4208   else df = MUS_UNKNOWN_SAMPLE;
4209 
4210   p = s7_cddr(p);
4211   fp = s7_car(p);
4212   if (fp != Xen_false)
4213     {
4214       if (!s7_is_integer(fp))
4215 	return(s7_wrong_type_arg_error(sc, S_save_sound_as, 5, fp, "an integer (header type)"));
4216       ht = (mus_header_t)s7_integer(fp);
4217     }
4218   else ht = MUS_UNKNOWN_HEADER;
4219 
4220   fp = s7_cadr(p);
4221   pchan = fp;
4222   if (fp != Xen_false)
4223     {
4224       if (!s7_is_integer(fp))
4225 	return(s7_wrong_type_arg_error(sc, S_save_sound_as, 6, fp, "an integer (channel)"));
4226       chan = s7_integer(fp);
4227     }
4228   else chan = -1;
4229 
4230   p = s7_cddr(p);
4231   edpos = s7_car(p);
4232 
4233   fp = s7_cadr(p);
4234   if (fp != Xen_false)
4235     {
4236       if (!s7_is_string(fp))
4237 	return(s7_wrong_type_arg_error(sc, S_save_sound_as, 8, fp, "a string"));
4238       outcom = s7_string(fp);
4239     }
4240   else outcom = NULL;
4241 
4242 #else
4243 static Xen g_save_sound_as(Xen arglist)
4244 {
4245   snd_info *sp;
4246   file_info *hdr;
4247   mus_header_t ht = MUS_UNKNOWN_HEADER;
4248   mus_sample_t df = MUS_UNKNOWN_SAMPLE;
4249   int sr = -1, chan = -1, edit_position = AT_CURRENT_EDIT_POSITION;
4250   io_error_t io_err = IO_NO_ERROR;
4251   char *fname = NULL;
4252   const char *file = NULL, *outcom = NULL;
4253   Xen args[16];
4254   Xen keys[8];
4255   int orig_arg[8] = {0, 0, 0, 0, 0, 0, 0, 0};
4256   int i, vals, arglist_len;
4257   Xen edpos = Xen_undefined, index = Xen_undefined, pchan;
4258   bool free_outcom = false, filep;
4259 
4260   keys[0] = kw_file;
4261   keys[1] = kw_sound;
4262   keys[2] = kw_srate;
4263   keys[3] = kw_sample_type;
4264   keys[4] = kw_header_type;
4265   keys[5] = kw_channel;
4266   keys[6] = kw_edit_position;
4267   keys[7] = kw_comment;
4268 
4269   for (i = 0; i < 16; i++) args[i] = Xen_undefined;
4270   arglist_len = Xen_list_length(arglist);
4271   if (arglist_len > 16)
4272     Xen_out_of_range_error(S_save_sound_as, 0, arglist, "too many arguments");
4273 
4274   for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
4275   vals = mus_optkey_unscramble(S_save_sound_as, arglist_len, 8, keys, args, orig_arg);
4276 
4277   if (vals > 0)
4278     {
4279       file = mus_optkey_to_string(keys[0], S_save_sound_as, orig_arg[0], NULL);
4280       if (!(Xen_is_keyword(keys[1]))) index = keys[1];
4281       ht = (mus_header_t)mus_optkey_to_int(keys[4], S_save_sound_as, orig_arg[4], (int)ht);
4282       df = (mus_sample_t)mus_optkey_to_int(keys[3], S_save_sound_as, orig_arg[3], (int)df);
4283       sr = mus_optkey_to_int(keys[2], S_save_sound_as, orig_arg[2], sr);
4284 
4285       if ((sr <= 0) && (!Xen_is_keyword(keys[2])))
4286 	Xen_error(Xen_make_error_type("cannot-save"),
4287 		  Xen_list_2(C_string_to_Xen_string(S_save_sound_as ": srate (~A) can't be <= 0"),
4288 			     C_int_to_Xen_integer(sr)));
4289 
4290       chan = mus_optkey_to_int(keys[5], S_save_sound_as, orig_arg[5], chan);
4291       if (!(Xen_is_keyword(keys[6])))
4292 	edpos = keys[6];
4293       outcom = mus_optkey_to_string(keys[7], S_save_sound_as, orig_arg[7], NULL);
4294     }
4295   pchan = keys[5];
4296   filep = keys[0];
4297 #endif
4298 
4299   if ((!file) ||
4300       (is_directory(file)))
4301     Xen_error(NO_SUCH_FILE,
4302 	      Xen_list_1(C_string_to_Xen_string(S_save_sound_as ": no output file?")));
4303 
4304   Snd_assert_sound(S_save_sound_as, index, 2);
4305 
4306   sp = get_sp(index);
4307   if (!sp)
4308     return(snd_no_such_sound_error(S_save_sound_as, index));
4309   hdr = sp->hdr;
4310 
4311   if (ht == MUS_UNKNOWN_HEADER) ht = hdr->type;
4312   if (!(mus_header_writable(ht, MUS_IGNORE_SAMPLE)))
4313     Xen_error(Xen_make_error_type("cannot-save"),
4314 	      Xen_list_2(C_string_to_Xen_string(S_save_sound_as ": can't write ~A headers"),
4315 			 C_string_to_Xen_string(mus_header_type_name(ht))));
4316 
4317   if (sr == -1)
4318     sr = hdr->srate;
4319 
4320   if (df == MUS_UNKNOWN_SAMPLE)
4321     {
4322       /* try to find some writable sample_type */
4323       df = hdr->sample_type;
4324       if (!mus_header_writable(ht, df))
4325 	df = MUS_OUT_SAMPLE_TYPE;
4326       if (!mus_header_writable(ht, df))
4327 	{
4328 	  switch (df)
4329 	    {
4330 	    case MUS_BFLOAT:  df = MUS_LFLOAT;  break;
4331 	    case MUS_BDOUBLE: df = MUS_LDOUBLE; break;
4332 	    case MUS_BINT:    df = MUS_LINT;    break;
4333 	    case MUS_LFLOAT:  df = MUS_BFLOAT;  break;
4334 	    case MUS_LDOUBLE: df = MUS_BDOUBLE; break;
4335 	    case MUS_LINT:    df = MUS_BINT;    break;
4336 	    default: break;
4337 	    }
4338 	  if (!mus_header_writable(ht, df))
4339 	    {
4340 	      int i;
4341 	      for (i = 1; i < MUS_NUM_SAMPLES; i++) /* MUS_UNKNOWN_SAMPLE is 0 */
4342 		{
4343 		  df = (mus_sample_t)i;
4344 		  if (mus_header_writable(ht, df))
4345 		    break;
4346 		}
4347 	    }
4348 	}
4349     }
4350 
4351   if (!mus_header_writable(ht, df))
4352     Xen_error(Xen_make_error_type("cannot-save"),
4353 	      Xen_list_3(C_string_to_Xen_string(S_save_sound_as ": can't write ~A data to ~A headers"),
4354 			 C_string_to_Xen_string(mus_sample_type_name(df)),
4355 			 C_string_to_Xen_string(mus_header_type_name(ht))));
4356 
4357   if (chan >= (int)(sp->nchans))
4358     return(snd_no_such_channel_error(S_save_sound_as, index, pchan));
4359 
4360   if (Xen_is_integer(edpos))
4361     {
4362       int i;
4363       edit_position = to_c_edit_position(sp->chans[(chan >= 0) ? chan : 0], edpos, S_save_sound_as, 7);
4364       for (i = 0; i < (int)sp->nchans; i++)
4365 	if (edit_position > sp->chans[i]->edit_ctr)
4366 	  Xen_error(Xen_make_error_type("no-such-edit"),
4367 		    Xen_list_5(C_string_to_Xen_string(S_save_sound_as ": no such edit position: ~A (~S chan ~A has ~A edits)"),
4368 			       C_int_to_Xen_integer(edit_position),
4369 			       C_string_to_Xen_string(sp->short_filename),
4370 			       C_int_to_Xen_integer(i),
4371 			       C_int_to_Xen_integer(sp->chans[i]->edit_ctr)));
4372     }
4373 
4374   fname = mus_expand_filename(file);
4375   if (!outcom)
4376     {
4377       outcom = output_comment(hdr);
4378       if (outcom) free_outcom = true;
4379     }
4380 
4381   if (!(run_before_save_as_hook(sp, fname, false, sr, df, ht, outcom)))
4382     {
4383       if (chan >= 0)
4384 	io_err = channel_to_file_with_settings(sp->chans[chan], fname, sr, df, ht, outcom, edit_position);
4385       else io_err = save_edits_without_display(sp, fname, ht, df, sr, outcom, edit_position);
4386     }
4387 
4388   if (free_outcom)
4389     {
4390       free((char *)outcom);
4391       outcom = NULL;
4392     }
4393 
4394   if (io_err == IO_NO_ERROR)
4395     run_after_save_as_hook(sp, fname, false); /* true => from dialog */
4396   else
4397     {
4398       if (io_err != IO_SAVE_HOOK_CANCELLATION)
4399 	{
4400 	  Xen errstr;
4401 	  errstr = C_string_to_Xen_string(fname);
4402 	  if (fname) {free(fname); fname = NULL;}
4403 	  Xen_error(Xen_make_error_type("cannot-save"),
4404 		    Xen_list_3(C_string_to_Xen_string(S_save_sound_as ": ~A (~A)"),
4405 			       errstr,
4406 			       C_string_to_Xen_string(snd_open_strerror())));
4407 	}
4408     }
4409 
4410   if (fname) free(fname);
4411   return(filep);
4412 }
4413 
4414   #if HAVE_SCHEME
4415     #define new_sound_example "(" S_new_sound " \"test.snd\" 1 22050 " S_mus_bshort " " S_mus_next " \"no comment\" 1000)"
4416   #endif
4417   #if HAVE_RUBY
4418     #define new_sound_example "new_sound(\"test.snd\", 1, 22050, Mus_bshort, Mus_next, \"no comment\", 1000)"
4419   #endif
4420   #if HAVE_FORTH
4421     #define new_sound_example "\"test.snd\" 1 22050 mus-bshort mus-next \"no comment\" 1000 new-sound"
4422   #endif
4423 
4424   #define H_new_sound "(" S_new_sound " file channels srate sample-type header-type comment size): \
4425 creates a new sound file with the indicated attributes; if any are omitted, the corresponding default-output variable is used. \
4426 The 'size' argument sets the number of samples (zeros) in the newly created sound. \n  " new_sound_example
4427 
4428 #if HAVE_SCHEME
4429 static s7_pointer g_new_sound(s7_scheme *sc, s7_pointer args)
4430 {
4431   snd_info *sp = NULL;
4432   mus_header_t ht;
4433   mus_sample_t df;
4434   char *str;
4435   int sr, ch, chan;
4436   mus_long_t size, len;
4437   const char *com;
4438   io_error_t io_err;
4439   s7_pointer p, fp;
4440 
4441   fp = s7_car(args);
4442   if (fp != Xen_false)
4443     {
4444       const char *file;
4445       if (!s7_is_string(fp))
4446 	return(s7_wrong_type_arg_error(sc, S_new_sound, 1, fp, "a string (a filename)"));
4447       file = s7_string(fp);
4448       str = mus_expand_filename(file);
4449       if (!str)
4450 	Xen_out_of_range_error(S_new_sound, 1, fp, "bad file name?");
4451     }
4452   else str = snd_tempnam();
4453   mus_sound_forget(str);
4454 
4455   fp = s7_cadr(args);
4456   if (fp != Xen_false)
4457     {
4458       if (!s7_is_integer(fp))
4459 	return(s7_wrong_type_arg_error(sc, S_new_sound, 2, fp, "an integer (channels)"));
4460       ch = s7_integer(fp);
4461       if (ch <= 0)
4462 	Xen_out_of_range_error(S_new_sound, 2, fp, "channels <= 0?");
4463     }
4464   else ch = default_output_chans(ss);
4465 
4466   p = s7_cddr(args);
4467   fp = s7_car(p);
4468   if (fp != Xen_false)
4469     {
4470       if (!s7_is_integer(fp))
4471 	return(s7_wrong_type_arg_error(sc, S_new_sound, 3, fp, "an integer (srate)"));
4472       sr = s7_integer(fp);
4473       if (sr <= 0)
4474 	Xen_out_of_range_error(S_new_sound, 3, fp, "srate <= 0?");
4475     }
4476   else sr = default_output_srate(ss);
4477 
4478   fp = s7_cadr(p);
4479   if (fp != Xen_false)
4480     {
4481       if (!s7_is_integer(fp))
4482 	return(s7_wrong_type_arg_error(sc, S_new_sound, 4, fp, "an integer (sample type)"));
4483       df = (mus_sample_t)s7_integer(fp);
4484       if (!(mus_is_sample_type(df)))
4485 	Xen_out_of_range_error(S_new_sound, 4, fp, "invalid sample type");
4486     }
4487   else df = default_output_sample_type(ss);
4488 
4489   p = s7_cddr(p);
4490   fp = s7_car(p);
4491   if (fp != Xen_false)
4492     {
4493       if (!s7_is_integer(fp))
4494 	return(s7_wrong_type_arg_error(sc, S_new_sound, 5, fp, "an integer (header type)"));
4495       ht = (mus_header_t)s7_integer(fp);
4496       if (!(mus_is_header_type(ht)))
4497 	Xen_out_of_range_error(S_new_sound, 5, fp, "invalid header type");
4498       if (!(mus_header_writable(ht, df)))
4499 	Xen_error(BAD_HEADER,
4500 		  Xen_list_3(C_string_to_Xen_string(S_new_sound ": can't write ~A data to a ~A header"),
4501 			     C_string_to_Xen_string(mus_sample_type_short_name(df)),
4502 			     C_string_to_Xen_string(mus_header_type_name(ht))));
4503     }
4504   else ht = default_output_header_type(ss);
4505 
4506   fp = s7_cadr(p);
4507   if (fp != Xen_false)
4508     {
4509       if (!s7_is_string(fp))
4510 	return(s7_wrong_type_arg_error(sc, S_new_sound, 6, fp, "a string"));
4511       com = s7_string(fp);
4512     }
4513   else com = NULL;
4514 
4515   fp = s7_caddr(p);
4516   if (fp != Xen_false)
4517     {
4518       if (!s7_is_integer(fp))
4519 	return(s7_wrong_type_arg_error(sc, S_new_sound, 7, fp, "an integer (initial file size)"));
4520       len = s7_integer(fp);
4521       if (len < 0)
4522 	Xen_out_of_range_error(S_new_sound, 7, fp, "size < 0?");
4523     }
4524   else len = 1;
4525 
4526   io_err = snd_write_header(str, ht, sr, ch, len * ch, df, com, NULL); /* last arg is loop info */
4527   if (io_err != IO_NO_ERROR)
4528     {
4529       s7_pointer filep;
4530       filep = s7_make_string(sc, str);
4531       if (str) {free(str); str = NULL;}
4532       Xen_error(Xen_make_error_type("IO-error"),
4533 		Xen_list_3(C_string_to_Xen_string(S_new_sound ": ~S, ~A"),
4534 			   filep,
4535 			   C_string_to_Xen_string(snd_io_strerror())));
4536     }
4537 
4538   chan = snd_reopen_write(str);
4539   lseek(chan, mus_header_data_location(), SEEK_SET);
4540 
4541   size = ch * mus_samples_to_bytes(df, len);
4542   if (size > 0)
4543     {
4544       unsigned char *buf;
4545       buf = (unsigned char *)calloc(size, sizeof(unsigned char));
4546       if (write(chan, buf, size) != size) fprintf(stderr, "new-sound %s write error", str);
4547       free(buf);
4548     }
4549 
4550   snd_close(chan, str);
4551   ss->open_requestor = FROM_NEW_SOUND;
4552 
4553   sp = sound_is_silence(snd_open_file(str, FILE_READ_WRITE));
4554 
4555   if (str) free(str);
4556   if (sp) return(C_int_to_Xen_sound(sp->index));
4557   return(Xen_false);
4558 }
4559 #else
4560 static Xen g_new_sound(Xen arglist)
4561 {
4562   snd_info *sp = NULL;
4563   mus_header_t ht;
4564   mus_sample_t df;
4565   int sr, ch, chan;
4566   mus_long_t size, len = 1;
4567   char *str = NULL;
4568   const char *com = NULL, *file = NULL;
4569   Xen args[14];
4570   Xen keys[7];
4571   int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
4572   int vals, i, arglist_len;
4573   io_error_t io_err;
4574 
4575   keys[0] = kw_file;
4576   keys[1] = kw_channels;
4577   keys[2] = kw_srate;
4578   keys[3] = kw_sample_type;
4579   keys[4] = kw_header_type;
4580   keys[5] = kw_comment;
4581   keys[6] = kw_size;
4582 
4583   for (i = 0; i < 14; i++) args[i] = Xen_undefined;
4584   arglist_len = Xen_list_length(arglist);
4585   if (arglist_len > 14)
4586     Xen_out_of_range_error(S_open_raw_sound, 0, arglist, "too many arguments");
4587 
4588   for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
4589   vals = mus_optkey_unscramble(S_new_sound, arglist_len, 7, keys, args, orig_arg);
4590 
4591   ht = default_output_header_type(ss);
4592   df = default_output_sample_type(ss);
4593   sr = default_output_srate(ss);
4594   ch = default_output_chans(ss);
4595 
4596   if (vals > 0)
4597     {
4598       file = mus_optkey_to_string(keys[0], S_new_sound, orig_arg[0], NULL);
4599       /* this can be null if :file is not passed as an arg (use temp name below) */
4600       ht = (mus_header_t)mus_optkey_to_int(keys[4], S_new_sound, orig_arg[4], (int)ht);
4601       df = (mus_sample_t)mus_optkey_to_int(keys[3], S_new_sound, orig_arg[3], (int)df);
4602       sr = mus_optkey_to_int(keys[2], S_new_sound, orig_arg[2], sr);
4603       ch = mus_optkey_to_int(keys[1], S_new_sound, orig_arg[1], ch);
4604       com = mus_optkey_to_string(keys[5], S_new_sound, orig_arg[5], NULL);
4605       len = mus_optkey_to_mus_long_t(keys[6], S_new_sound, orig_arg[6], len);
4606     }
4607 
4608   if (!(mus_is_header_type(ht)))
4609     Xen_out_of_range_error(S_new_sound, orig_arg[4], keys[4], "invalid header type");
4610 
4611   if (!(mus_is_sample_type(df)))
4612     Xen_out_of_range_error(S_new_sound, orig_arg[3], keys[3], "invalid sample type");
4613 
4614   if (!(mus_header_writable(ht, df)))
4615     Xen_error(BAD_HEADER,
4616 	      Xen_list_3(C_string_to_Xen_string(S_new_sound ": can't write ~A data to a ~A header"),
4617 			 C_string_to_Xen_string(mus_sample_type_short_name(df)),
4618 			 C_string_to_Xen_string(mus_header_type_name(ht))));
4619 
4620   if (sr <= 0)
4621     Xen_out_of_range_error(S_new_sound, orig_arg[2], keys[2], "srate <= 0?");
4622 
4623   if (ch <= 0)
4624     Xen_out_of_range_error(S_new_sound, orig_arg[1], keys[1], "channels <= 0?");
4625 
4626   if (len < 0)
4627     Xen_out_of_range_error(S_new_sound, orig_arg[6], keys[6], "size < 0?");
4628 
4629   if (file)
4630     {
4631       str = mus_expand_filename(file);
4632       if (!str)
4633 	Xen_out_of_range_error(S_new_sound, orig_arg[0], keys[0], "bad file name?");
4634     }
4635   else str = snd_tempnam();
4636   mus_sound_forget(str);
4637 
4638   io_err = snd_write_header(str, ht, sr, ch, len * ch, df, com, NULL); /* last arg is loop info */
4639   if (io_err != IO_NO_ERROR)
4640     {
4641       if (str) {free(str); str = NULL;}
4642       Xen_error(Xen_make_error_type("IO-error"),
4643 		Xen_list_3(C_string_to_Xen_string(S_new_sound ": ~S, ~A"),
4644 			   keys[0],
4645 			   C_string_to_Xen_string(snd_io_strerror())));
4646     }
4647 
4648   chan = snd_reopen_write(str);
4649   lseek(chan, mus_header_data_location(), SEEK_SET);
4650 
4651   size = ch * mus_samples_to_bytes(df, len);
4652   if (size > 0)
4653     {
4654       unsigned char *buf;
4655       buf = (unsigned char *)calloc(size, sizeof(unsigned char));
4656       if (write(chan, buf, size) != size) fprintf(stderr, "new-sound %s write error", str);
4657       free(buf);
4658     }
4659 
4660   snd_close(chan, str);
4661   ss->open_requestor = FROM_NEW_SOUND;
4662 
4663   sp = sound_is_silence(snd_open_file(str, FILE_READ_WRITE));
4664 
4665   if (str) free(str);
4666   if (sp) return(C_int_to_Xen_sound(sp->index));
4667   return(Xen_false);
4668 }
4669 #endif
4670 
4671 static Xen g_speed_control_style(Xen snd)
4672 {
4673   #define H_speed_control_style "(" S_speed_control_style " :optional snd): speed control panel interpretation \
4674 choice: " S_speed_control_as_float ", " S_speed_control_as_ratio ", or " S_speed_control_as_semitone "."
4675 
4676   return(sound_get_global(snd, SP_SPEED_STYLE, S_speed_control_style));
4677 }
4678 
4679 
4680 static Xen g_set_speed_control_style(Xen speed, Xen snd)
4681 {
4682   int in_spd;
4683   speed_style_t spd;
4684 
4685   Xen_check_type(Xen_is_integer(speed), speed, 1, S_set S_speed_control_style, "an integer");
4686 
4687   in_spd = Xen_integer_to_C_int(speed);
4688   if (in_spd < 0)
4689     Xen_out_of_range_error(S_set S_speed_control_style, 1, speed, "invalid " S_speed_control_style);
4690 
4691   spd = (speed_style_t)in_spd;
4692   if (spd >= NUM_SPEED_CONTROL_STYLES)
4693     Xen_out_of_range_error(S_set S_speed_control_style, 1, speed,
4694 			   S_speed_control_style " should be " S_speed_control_as_float ", " S_speed_control_as_ratio ", or " S_speed_control_as_semitone);
4695 
4696   return(sound_set_global(snd, speed, SP_SPEED_STYLE, S_set S_speed_control_style));
4697 }
4698 
4699 with_two_setter_args(g_set_speed_control_style_reversed, g_set_speed_control_style)
4700 
4701 
4702 static Xen g_speed_control_tones(Xen snd)
4703 {
4704   #define H_speed_control_tones "(" S_speed_control_tones " :optional snd): if " S_speed_control_style " is " S_speed_control_as_semitone ", this chooses the octave divisions (12)"
4705   return(sound_get_global(snd, SP_SPEED_TONES, S_speed_control_tones));
4706 }
4707 
4708 
4709 static Xen g_set_speed_control_tones(Xen val, Xen snd)
4710 {
4711   Xen_check_type(Xen_is_number(val), val, 1, S_set S_speed_control_tones, "a number");
4712   return(sound_set_global(snd, val, SP_SPEED_TONES, S_set S_speed_control_tones));
4713 }
4714 
4715 with_two_setter_args(g_set_speed_control_tones_reversed, g_set_speed_control_tones)
4716 
4717 
4718 static Xen g_amp_control(Xen snd, Xen chn_n)
4719 {
4720   #define H_amp_control "(" S_amp_control " :optional snd chn): current amp slider setting"
4721   if (Xen_is_bound(chn_n))
4722     {
4723       chan_info *cp;
4724       Snd_assert_channel(S_amp_control, snd, chn_n, 1);
4725       cp = get_cp(snd, chn_n, S_amp_control);
4726       if (!cp) return(Xen_false);
4727       if (cp->amp_control)
4728 	return(C_double_to_Xen_real(cp->amp_control[0]));
4729     }
4730   return(sound_get(snd, SP_AMP, S_amp_control));
4731 }
4732 
4733 
4734 static Xen g_set_amp_control(Xen on, Xen snd, Xen chn_n)
4735 {
4736   Xen_check_type(Xen_is_number(on), on, 1, S_set S_amp_control, "a number");
4737 
4738   if (Xen_is_bound(chn_n))
4739     {
4740       chan_info *cp;
4741       Snd_assert_channel(S_amp_control, snd, chn_n, 2);
4742       cp = get_cp(snd, chn_n, S_amp_control);
4743       if (!cp) return(Xen_false);
4744       if (!cp->amp_control)
4745 	cp->amp_control = (mus_float_t *)calloc(1, sizeof(mus_float_t));
4746       cp->amp_control[0] = (mus_float_t)Xen_real_to_C_double(on);
4747       return(on);
4748     }
4749 
4750   return(sound_set(snd, on, SP_AMP, S_set S_amp_control));
4751 }
4752 
4753 with_three_setter_args(g_set_amp_control_reversed, g_set_amp_control)
4754 
4755 
4756 static Xen g_amp_control_bounds(Xen snd)
4757 {
4758   #define H_amp_control_bounds "(" S_amp_control_bounds " :optional snd): current amp slider bounds (default: '(0.0 8.0))"
4759   return(sound_get_global(snd, SP_AMP_BOUNDS, S_amp_control_bounds));
4760 }
4761 
4762 
4763 static Xen g_set_amp_control_bounds(Xen on, Xen snd)
4764 {
4765   Xen_check_type(Xen_is_list(on), on, 1, S_set S_amp_control_bounds, "a list of the new min and max values");
4766 
4767   if ((Xen_list_length(on) != 2) ||
4768       (!(Xen_is_number(Xen_car(on)))) ||
4769       (!(Xen_is_number(Xen_cadr(on)))))
4770     Xen_wrong_type_arg_error(S_set S_amp_control_bounds, 1, on, "a list of 2 numbers");
4771 
4772   if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
4773     Xen_out_of_range_error(S_set S_amp_control_bounds, 1, on, "min >= max");
4774 
4775   return(sound_set_global(snd, on, SP_AMP_BOUNDS, S_set S_amp_control_bounds));
4776 }
4777 
4778 with_two_setter_args(g_set_amp_control_bounds_reversed, g_set_amp_control_bounds)
4779 
4780 
4781 static Xen g_contrast_control(Xen snd)
4782 {
4783   #define H_contrast_control "(" S_contrast_control " :optional snd): current contrast slider setting"
4784   return(sound_get(snd, SP_CONTRAST, S_contrast_control));
4785 }
4786 
4787 
4788 static Xen g_set_contrast_control(Xen on, Xen snd)
4789 {
4790   Xen_check_type(Xen_is_number(on), on, 1, S_set S_contrast_control, "a number");
4791   return(sound_set(snd, on, SP_CONTRAST, S_set S_contrast_control));
4792 }
4793 
4794 with_two_setter_args(g_set_contrast_control_reversed, g_set_contrast_control)
4795 
4796 
4797 static Xen g_contrast_control_bounds(Xen snd)
4798 {
4799   #define H_contrast_control_bounds "(" S_contrast_control_bounds " :optional snd): current contrast slider bounds (default: '(0.0 10.0))"
4800   return(sound_get_global(snd, SP_CONTRAST_BOUNDS, S_contrast_control_bounds));
4801 }
4802 
4803 
4804 static Xen g_set_contrast_control_bounds(Xen on, Xen snd)
4805 {
4806   Xen_check_type(Xen_is_list(on), on, 1, S_set S_contrast_control_bounds, "a list of the new min and max values");
4807 
4808   if ((Xen_list_length(on) != 2) ||
4809       (!(Xen_is_number(Xen_car(on)))) ||
4810       (!(Xen_is_number(Xen_cadr(on)))))
4811     Xen_wrong_type_arg_error(S_set S_contrast_control_bounds, 1, on, "a list of 2 numbers");
4812 
4813   if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
4814     Xen_out_of_range_error(S_set S_contrast_control_bounds, 1, on, "min >= max");
4815 
4816   return(sound_set_global(snd, on, SP_CONTRAST_BOUNDS, S_set S_contrast_control_bounds));
4817 }
4818 
4819 with_two_setter_args(g_set_contrast_control_bounds_reversed, g_set_contrast_control_bounds)
4820 
4821 
4822 static Xen g_contrast_control_amp(Xen snd)
4823 {
4824   #define H_contrast_control_amp "(" S_contrast_control_amp " :optional snd): snd's contrast amp\n\
4825    (scaler on data before contrast operation in control panel, 1.0)"
4826 
4827   return(sound_get_global(snd, SP_CONTRAST_AMP, S_contrast_control_amp));
4828 }
4829 
4830 
4831 static Xen g_set_contrast_control_amp(Xen on, Xen snd)
4832 {
4833   Xen_check_type(Xen_is_number(on), on, 1, S_set S_contrast_control_amp, "a number");
4834   return(sound_set_global(snd, on, SP_CONTRAST_AMP, S_set S_contrast_control_amp));
4835 }
4836 
4837 with_two_setter_args(g_set_contrast_control_amp_reversed, g_set_contrast_control_amp)
4838 
4839 
4840 static Xen g_expand_control(Xen snd)
4841 {
4842   #define H_expand_control "(" S_expand_control " :optional snd): current expand slider setting"
4843   return(sound_get(snd, SP_EXPAND, S_expand_control));
4844 }
4845 
4846 
4847 static Xen g_set_expand_control(Xen on, Xen snd)
4848 {
4849   Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control, "a number");
4850   return(sound_set(snd, on, SP_EXPAND, S_set S_expand_control));
4851 }
4852 
4853 with_two_setter_args(g_set_expand_control_reversed, g_set_expand_control)
4854 
4855 
4856 static Xen g_expand_control_bounds(Xen snd)
4857 {
4858   #define H_expand_control_bounds "(" S_expand_control_bounds " :optional snd): current expand slider bounds (default: '(0.001 20.0))"
4859   return(sound_get_global(snd, SP_EXPAND_BOUNDS, S_expand_control_bounds));
4860 }
4861 
4862 
4863 static Xen g_set_expand_control_bounds(Xen on, Xen snd)
4864 {
4865   Xen_check_type(Xen_is_list(on), on, 1, S_set S_expand_control_bounds, "a list of the new min and max values");
4866 
4867   if ((Xen_list_length(on) != 2) ||
4868       (!(Xen_is_number(Xen_car(on)))) ||
4869       (!(Xen_is_number(Xen_cadr(on)))))
4870     Xen_wrong_type_arg_error(S_set S_expand_control_bounds, 1, on, "a list of 2 numbers");
4871 
4872   if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
4873     Xen_out_of_range_error(S_set S_expand_control_bounds, 1, on, "min >= max");
4874 
4875   if (Xen_real_to_C_double(Xen_car(on)) <= 0.0)
4876     Xen_out_of_range_error(S_set S_expand_control_bounds, 1, on, "min <= 0.0");
4877 
4878   return(sound_set_global(snd, on, SP_EXPAND_BOUNDS, S_set S_expand_control_bounds));
4879 }
4880 
4881 with_two_setter_args(g_set_expand_control_bounds_reversed, g_set_expand_control_bounds)
4882 
4883 
4884 static Xen g_expand_control_length(Xen snd)
4885 {
4886   #define H_expand_control_length "(" S_expand_control_length " :optional snd): current expansion segment length in seconds (.15)"
4887   return(sound_get_global(snd, SP_EXPAND_LENGTH, S_expand_control_length));
4888 }
4889 
4890 
4891 static Xen g_set_expand_control_length(Xen on, Xen snd)
4892 {
4893   Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_length, "a number");
4894   return(sound_set_global(snd, on, SP_EXPAND_LENGTH, S_set S_expand_control_length));
4895 }
4896 
4897 with_two_setter_args(g_set_expand_control_length_reversed, g_set_expand_control_length)
4898 
4899 
4900 static Xen g_expand_control_ramp(Xen snd)
4901 {
4902   #define H_expand_control_ramp "(" S_expand_control_ramp " :optional snd): current expansion ramp time (.4)"
4903   return(sound_get_global(snd, SP_EXPAND_RAMP, S_expand_control_ramp));
4904 }
4905 
4906 
4907 static Xen g_set_expand_control_ramp(Xen on, Xen snd)
4908 {
4909   Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_ramp, "a number");
4910   return(sound_set_global(snd, on, SP_EXPAND_RAMP, S_set S_expand_control_ramp));
4911 }
4912 
4913 with_two_setter_args(g_set_expand_control_ramp_reversed, g_set_expand_control_ramp)
4914 
4915 
4916 static Xen g_expand_control_hop(Xen snd)
4917 {
4918   #define H_expand_control_hop "(" S_expand_control_hop " :optional snd): current expansion output grain spacing in seconds (0.05)"
4919   return(sound_get_global(snd, SP_EXPAND_HOP, S_expand_control_hop));
4920 }
4921 
4922 
4923 static Xen g_set_expand_control_hop(Xen on, Xen snd)
4924 {
4925   Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_hop, "a number");
4926   return(sound_set_global(snd, on, SP_EXPAND_HOP, S_set S_expand_control_hop));
4927 }
4928 
4929 with_two_setter_args(g_set_expand_control_hop_reversed, g_set_expand_control_hop)
4930 
4931 
4932 static Xen g_expand_control_jitter(Xen snd)
4933 {
4934   #define H_expand_control_jitter "(" S_expand_control_jitter " :optional snd): current expansion output grain spacing jitter (0.1)"
4935   return(sound_get_global(snd, SP_EXPAND_JITTER, S_expand_control_jitter));
4936 }
4937 
4938 
4939 static Xen g_set_expand_control_jitter(Xen on, Xen snd)
4940 {
4941   Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_jitter, "a number");
4942   return(sound_set_global(snd, on, SP_EXPAND_JITTER, S_set S_expand_control_jitter));
4943 }
4944 
4945 with_two_setter_args(g_set_expand_control_jitter_reversed, g_set_expand_control_jitter)
4946 
4947 
4948 static Xen g_speed_control(Xen snd)
4949 {
4950   #define H_speed_control "(" S_speed_control " :optional snd): current speed (srate) slider setting"
4951   return(sound_get(snd, SP_SPEED, S_speed_control));
4952 }
4953 
4954 
4955 static Xen g_set_speed_control(Xen on, Xen snd)
4956 {
4957   Xen_check_type(Xen_is_number(on), on, 1, S_set S_speed_control, "a number");
4958   return(sound_set(snd, on, SP_SPEED, S_set S_speed_control));
4959 }
4960 
4961 with_two_setter_args(g_set_speed_control_reversed, g_set_speed_control)
4962 
4963 
4964 static Xen g_speed_control_bounds(Xen snd)
4965 {
4966   #define H_speed_control_bounds "(" S_speed_control_bounds " :optional snd): current speed slider bounds (default: '(0.05 20.0))"
4967   return(sound_get_global(snd, SP_SPEED_BOUNDS, S_speed_control_bounds));
4968 }
4969 
4970 
4971 static Xen g_set_speed_control_bounds(Xen on, Xen snd)
4972 {
4973   Xen_check_type(Xen_is_list(on), on, 1, S_set S_speed_control_bounds, "a list of the new min and max values");
4974 
4975   if ((Xen_list_length(on) != 2) ||
4976       (!(Xen_is_number(Xen_car(on)))) ||
4977       (!(Xen_is_number(Xen_cadr(on)))))
4978     Xen_wrong_type_arg_error(S_set S_speed_control_bounds, 1, on, "a list of 2 numbers");
4979 
4980   if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
4981     Xen_out_of_range_error(S_set S_speed_control_bounds, 1, on, "min >= max");
4982 
4983   if (Xen_real_to_C_double(Xen_car(on)) <= 0.0)
4984     Xen_out_of_range_error(S_set S_speed_control_bounds, 1, on, "min <= 0.0");
4985 
4986   return(sound_set_global(snd, on, SP_SPEED_BOUNDS, S_set S_speed_control_bounds));
4987 }
4988 
4989 with_two_setter_args(g_set_speed_control_bounds_reversed, g_set_speed_control_bounds)
4990 
4991 
4992 static Xen g_reverb_control_length(Xen snd)
4993 {
4994   #define H_reverb_control_length "(" S_reverb_control_length " :optional snd): reverb decay length scaler"
4995   return(sound_get(snd, SP_REVERB_LENGTH, S_reverb_control_length));
4996 }
4997 
4998 
4999 static Xen g_set_reverb_control_length(Xen on, Xen snd)
5000 {
5001   Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_length, "a number");
5002   return(sound_set(snd, on, SP_REVERB_LENGTH, S_set S_reverb_control_length));
5003 }
5004 
5005 with_two_setter_args(g_set_reverb_control_length_reversed, g_set_reverb_control_length)
5006 
5007 
5008 static Xen g_reverb_control_length_bounds(Xen snd)
5009 {
5010   #define H_reverb_control_length_bounds "(" S_reverb_control_length_bounds " :optional snd): current reverb length slider bounds (default: '(0.0 5.0))"
5011   return(sound_get_global(snd, SP_REVERB_LENGTH_BOUNDS, S_reverb_control_length_bounds));
5012 }
5013 
5014 
5015 static Xen g_set_reverb_control_length_bounds(Xen on, Xen snd)
5016 {
5017   Xen_check_type(Xen_is_list(on), on, 1, S_set S_reverb_control_length_bounds, "a list of the new min and max values");
5018 
5019   if ((Xen_list_length(on) != 2) ||
5020       (!(Xen_is_number(Xen_car(on)))) ||
5021       (!(Xen_is_number(Xen_cadr(on)))))
5022     Xen_wrong_type_arg_error(S_set S_reverb_control_length_bounds, 1, on, "a list of 2 numbers");
5023 
5024   if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
5025     Xen_out_of_range_error(S_set S_reverb_control_length_bounds, 1, on, "min >= max");
5026 
5027   return(sound_set_global(snd, on, SP_REVERB_LENGTH_BOUNDS, S_set S_reverb_control_length_bounds));
5028 }
5029 
5030 with_two_setter_args(g_set_reverb_control_length_bounds_reversed, g_set_reverb_control_length_bounds)
5031 
5032 
5033 static Xen g_reverb_control_feedback(Xen snd)
5034 {
5035   #define H_reverb_control_feedback "(" S_reverb_control_feedback " :optional snd): reverb feedback scaler"
5036   return(sound_get_global(snd, SP_REVERB_FEEDBACK, S_reverb_control_feedback));
5037 }
5038 
5039 
5040 static Xen g_set_reverb_control_feedback(Xen on, Xen snd)
5041 {
5042   Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_feedback, "a number");
5043   return(sound_set_global(snd, on, SP_REVERB_FEEDBACK, S_set S_reverb_control_feedback));
5044 }
5045 
5046 with_two_setter_args(g_set_reverb_control_feedback_reversed, g_set_reverb_control_feedback)
5047 
5048 
5049 static Xen g_reverb_control_scale(Xen snd)
5050 {
5051   #define H_reverb_control_scale "(" S_reverb_control_scale " :optional snd): reverb scaler (the amount of reverb)"
5052   return(sound_get(snd, SP_REVERB_SCALE, S_reverb_control_scale));
5053 }
5054 
5055 
5056 static Xen g_set_reverb_control_scale(Xen on, Xen snd)
5057 {
5058   Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_scale, "a number");
5059   return(sound_set(snd, on, SP_REVERB_SCALE, S_set S_reverb_control_scale));
5060 }
5061 
5062 with_two_setter_args(g_set_reverb_control_scale_reversed, g_set_reverb_control_scale)
5063 
5064 
5065 static Xen g_reverb_control_scale_bounds(Xen snd)
5066 {
5067   #define H_reverb_control_scale_bounds "(" S_reverb_control_scale_bounds " :optional snd): current reverb scale slider bounds (default: '(0.0 4.0))"
5068   return(sound_get_global(snd, SP_REVERB_SCALE_BOUNDS, S_reverb_control_scale_bounds));
5069 }
5070 
5071 
5072 static Xen g_set_reverb_control_scale_bounds(Xen on, Xen snd)
5073 {
5074   Xen_check_type(Xen_is_list(on), on, 1, S_set S_reverb_control_scale_bounds, "a list of the new min and max values");
5075 
5076   if ((Xen_list_length(on) != 2) ||
5077       (!(Xen_is_number(Xen_car(on)))) ||
5078       (!(Xen_is_number(Xen_cadr(on)))))
5079     Xen_wrong_type_arg_error(S_set S_reverb_control_scale_bounds, 1, on, "a list of 2 numbers");
5080 
5081   if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
5082     Xen_out_of_range_error(S_set S_reverb_control_scale_bounds, 1, on, "min >= max");
5083 
5084   return(sound_set_global(snd, on, SP_REVERB_SCALE_BOUNDS, S_set S_reverb_control_scale_bounds));
5085 }
5086 
5087 with_two_setter_args(g_set_reverb_control_scale_bounds_reversed, g_set_reverb_control_scale_bounds)
5088 
5089 
5090 static Xen g_reverb_control_lowpass(Xen snd)
5091 {
5092   #define H_reverb_control_lowpass "(" S_reverb_control_lowpass " :optional snd): reverb lowpass filter coefficient"
5093   return(sound_get_global(snd, SP_REVERB_LOW_PASS, S_reverb_control_lowpass));
5094 }
5095 
5096 
5097 static Xen g_set_reverb_control_lowpass(Xen on, Xen snd)
5098 {
5099   Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_lowpass, "a number");
5100   return(sound_set_global(snd, on, SP_REVERB_LOW_PASS, S_set S_reverb_control_lowpass));
5101 }
5102 
5103 with_two_setter_args(g_set_reverb_control_lowpass_reversed, g_set_reverb_control_lowpass)
5104 
5105 
5106 static Xen g_reverb_control_decay(Xen snd)
5107 {
5108   #define H_reverb_control_decay "(" S_reverb_control_decay " :optional snd): " S_apply_controls " reverb decay time (1.0 seconds)"
5109   return(sound_get_global(snd, SP_REVERB_DECAY, S_reverb_control_decay));
5110 }
5111 
5112 
5113 static Xen g_set_reverb_control_decay(Xen val, Xen snd)
5114 {
5115   Xen_check_type(Xen_is_number(val), val, 1, S_set S_reverb_control_decay, "a number");
5116   return(sound_set_global(snd, val, SP_REVERB_DECAY, S_set S_reverb_control_decay));
5117 }
5118 
5119 with_two_setter_args(g_set_reverb_control_decay_reversed, g_set_reverb_control_decay)
5120 
5121 
5122 static Xen g_filter_control_envelope(Xen snd)
5123 {
5124   #define H_filter_control_envelope "(" S_filter_control_envelope " :optional snd): snd's filter envelope (in the control panel)"
5125   return(sound_get(snd, SP_FILTER_ENVELOPE, S_filter_control_envelope));
5126 }
5127 
5128 
5129 static Xen g_set_filter_control_envelope(Xen val, Xen snd)
5130 {
5131   return(sound_set(snd, val, SP_FILTER_ENVELOPE, S_set S_filter_control_envelope));
5132 }
5133 
5134 with_two_setter_args(g_set_filter_control_envelope_reversed, g_set_filter_control_envelope)
5135 
5136 
5137 static void squelch_printout(const char *msg, void *ignore)
5138 {
5139 }
5140 
5141 
5142 static void apply_controls_error(const char *msg, void *data)
5143 {
5144   redirect_snd_warning_to(NULL, NULL);
5145   redirect_snd_error_to(NULL, NULL);
5146   Xen_error(Xen_make_error_type("cannot-apply-controls"),
5147 	    Xen_list_3(C_string_to_Xen_string("~A: ~A"),
5148 		       C_string_to_Xen_string((char *)data),
5149 		       C_string_to_Xen_string(msg)));
5150 }
5151 
5152 
5153 static Xen g_controls_to_channel(Xen settings, Xen beg, Xen dur, Xen snd, Xen chn, Xen origin)
5154 {
5155   #define H_controls_to_channel "(" S_controls_to_channel " settings :optional beg dur snd chn origin) sets up \
5156 snd's controls to reflect 'settings' (unspecified settings are not changed), then applies the controls as \
5157 an edit of channel 'chn'. The 'settings' argument is a list:\n\
5158 \n\
5159   (list amp speed\n\
5160     (list contrast contrast_amp)\n\
5161     (list expand expand_length expand_ramp expand_hop expand_jitter)\n\
5162     (list reverb_scale reverb_length reverb_feedback reverb_low_pass reverb_decay)\n\
5163     (list filter_order filter_env))\n\
5164 \n\
5165 where each inner list entry can also be " PROC_FALSE "."
5166 
5167   snd_info *sp;
5168   chan_info *cp;
5169 
5170   Xen_check_type(Xen_is_list(settings), settings, 1, S_controls_to_channel, "a list");
5171   Snd_assert_channel(S_controls_to_channel, snd, chn, 4);
5172   Xen_check_type(Xen_is_llong(beg) || Xen_is_false(beg) || !Xen_is_bound(beg), beg, 2, S_controls_to_channel, "an integer");
5173   Xen_check_type(Xen_is_llong(dur) || Xen_is_false(dur) || !Xen_is_bound(dur), dur, 3, S_controls_to_channel, "an integer");
5174   Xen_check_type(Xen_is_string_or_unbound(origin), origin, 7, S_controls_to_channel, "a string");
5175 
5176   sp = get_sp(snd); /* control changes make sense, but not 'apply' -- expecting just 'play' if a player */
5177   if (sp)
5178     {
5179       apply_state *ap;
5180       int old_selected_channel;
5181       ctrl_state *saved_settings;
5182       if (sp->applying)
5183 	{
5184 	  Xen_error(Xen_make_error_type("cannot-apply-controls"),
5185 		    Xen_list_1(C_string_to_Xen_string(S_controls_to_channel ": already applying controls")));
5186 	}
5187       if (Xen_is_llong(beg)) apply_beg = Xen_llong_to_C_llong(beg); else apply_beg = 0;
5188       if (Xen_is_llong(dur)) apply_dur = Xen_llong_to_C_llong(dur); else apply_dur = 0;
5189       cp = get_cp(snd, chn, S_controls_to_channel);
5190       old_selected_channel = sp->selected_channel;
5191       sp->selected_channel = cp->chan;
5192       saved_settings = current_control_settings(sp, NULL);
5193 
5194       /* now read the 'settings' list for any new settings */
5195       if ((Xen_is_list(settings)) && (!Xen_is_null(settings)))
5196 	{
5197 	  int i, len, elen;
5198 	  Xen lst;
5199 	  /* settings:
5200 	     (list amp speed
5201 	       (list contrast contrast_amp)
5202 	       (list expand expand_length expand_ramp expand_hop expand_jitter)
5203 	       (list reverb_scale reverb_length reverb_feedback reverb_low_pass reverb_decay)
5204 	       (list filter_order filter_env))
5205 	     where any (outer) items can be #f
5206 	  */
5207 	  len = Xen_list_length(settings);
5208 	  for (i = 0, lst = Xen_copy_arg(settings); i < len; i++, lst = Xen_cdr(lst))
5209 	    {
5210 	      Xen element;
5211 	      element = Xen_car(lst);
5212 	      switch (i)
5213 		{
5214 		case 0:
5215 		  if (Xen_is_number(element)) sp->amp_control = Xen_real_to_C_double(element);
5216 		  break;
5217 
5218 		case 1:
5219 		  if (Xen_is_number(element)) sp->speed_control = Xen_real_to_C_double(element);
5220 		  break;
5221 
5222 		case 2:
5223 		  if (Xen_is_list(element))
5224 		    {
5225 		      elen = Xen_list_length(element);
5226 		      if (elen > 0) {sp->contrast_control_on = true; sp->contrast_control = Xen_real_to_C_double(Xen_car(element));}
5227 		      if (elen > 1) sp->contrast_control_amp = Xen_real_to_C_double(Xen_cadr(element));
5228 		    }
5229 		  break;
5230 
5231 		case 3:
5232 		  if (Xen_is_list(element))
5233 		    {
5234 		      elen = Xen_list_length(element);
5235 		      if (elen > 0) {sp->expand_control_on = true; sp->expand_control = Xen_real_to_C_double(Xen_car(element));}
5236 		      if (elen > 1) sp->expand_control_length = Xen_real_to_C_double(Xen_cadr(element));
5237 		      if (elen > 2) sp->expand_control_ramp = Xen_real_to_C_double(Xen_caddr(element));
5238 		      if (elen > 3) sp->expand_control_hop = Xen_real_to_C_double(Xen_list_ref(element, 3));
5239 		      if (elen > 4) sp->expand_control_jitter = Xen_real_to_C_double(Xen_list_ref(element, 4));
5240 		    }
5241 		  break;
5242 
5243 		case 4:
5244 		  if (Xen_is_list(element))
5245 		    {
5246 		      elen = Xen_list_length(element);
5247 		      if (elen > 0) {sp->reverb_control_on = true; sp->reverb_control_scale = Xen_real_to_C_double(Xen_car(element));}
5248 		      if (elen > 1) sp->reverb_control_length = Xen_real_to_C_double(Xen_cadr(element));
5249 		      if (elen > 2) sp->reverb_control_feedback = Xen_real_to_C_double(Xen_caddr(element));
5250 		      if (elen > 3) sp->reverb_control_lowpass = Xen_real_to_C_double(Xen_list_ref(element, 3));
5251 		      if (elen > 4) sp->reverb_control_decay = Xen_real_to_C_double(Xen_list_ref(element, 4));
5252 		    }
5253 		  break;
5254 
5255 		case 5:
5256 		  if (Xen_is_list(element))
5257 		    {
5258 		      elen = Xen_list_length(element);
5259 		      if (elen > 0) {sp->filter_control_on = true; sp->filter_control_order = Xen_integer_to_C_int(Xen_car(element));}
5260 		      if (elen > 1) sp->filter_control_envelope = get_env(Xen_cadr(element), S_controls_to_channel);
5261 		    }
5262 		}
5263 	    }
5264 	}
5265 
5266       ss->apply_choice = APPLY_TO_CHANNEL;
5267       sp->applying = true;
5268       ap = (apply_state *)make_apply_state(sp);
5269 
5270 #if HAVE_EXTENSION_LANGUAGE
5271 #if HAVE_FORTH
5272       if (!(Xen_is_number(dur)))
5273 	ap->origin = mus_format("%s %" print_mus_long PROC_SEP PROC_FALSE " %s",
5274 				Xen_object_to_C_string(settings),
5275 				apply_beg, S_controls_to_channel);
5276       else ap->origin = mus_format("%s " PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long " %s",
5277 				   Xen_object_to_C_string(settings),
5278 				   apply_beg, apply_dur, S_controls_to_channel);
5279 #else
5280       {
5281 	char *temp = NULL;
5282 	if (!(Xen_is_number(dur)))
5283 	  ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%" print_mus_long PROC_SEP PROC_FALSE,
5284 				  to_proc_name(S_controls_to_channel),
5285 				  PROC_QUOTE,
5286 				  temp = Xen_object_to_C_string(settings),
5287 				  apply_beg);
5288 	else ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%" print_mus_long PROC_SEP "%" print_mus_long,
5289 				     to_proc_name(S_controls_to_channel),
5290 				     PROC_QUOTE,
5291 				     temp = Xen_object_to_C_string(settings),
5292 				     apply_beg, apply_dur);
5293 #if HAVE_SCHEME
5294 	if (temp) free(temp);
5295 #endif
5296       }
5297 #endif
5298 #endif
5299 
5300       if (ap)
5301 	{
5302 	  redirect_snd_error_to(apply_controls_error, (void *)S_controls_to_channel);
5303 	  redirect_snd_warning_to(squelch_printout, NULL);
5304 	  while (apply_controls(ap)) {};
5305 	  redirect_snd_warning_to(NULL, NULL); /* no-op message pointless within xen */
5306 	  redirect_snd_error_to(NULL, NULL);
5307 	}
5308       sp->selected_channel = old_selected_channel;
5309       restore_control_settings(sp, saved_settings);
5310       free_control_settings(saved_settings);
5311     }
5312 
5313   return(settings);
5314 }
5315 
5316 
5317 static Xen g_apply_controls(Xen snd, Xen choice, Xen beg, Xen dur)
5318 {
5319   #define H_apply_controls "(" S_apply_controls " :optional snd (choice 0) (beg 0) (dur len)): \
5320 applies the current control panel state as an edit. \
5321 The 'choices' are 0 (apply to sound), 1 (apply to channel), and 2 (apply to selection).  If 'beg' is given, the apply starts there."
5322 
5323   snd_info *sp;
5324 
5325   Snd_assert_sound(S_apply_controls, snd, 1);
5326   Xen_check_type(Xen_is_integer_or_unbound(choice), choice, 2, S_apply_controls, "an integer");
5327   Xen_check_type(Xen_is_integer_or_unbound(beg), beg, 3, S_apply_controls, "an integer");
5328   Xen_check_type(Xen_is_integer_or_unbound(dur), dur, 4, S_apply_controls, "an integer");
5329 
5330   sp = get_sp(snd); /* control changes make sense, but not 'apply' -- expecting just 'play' if a player */
5331   if (sp)
5332     {
5333       apply_state *ap;
5334       snd_apply_t cur_choice = APPLY_TO_SOUND;
5335 
5336       if (sp->applying)
5337 	{
5338 	  Xen_error(Xen_make_error_type("cannot-apply-controls"),
5339 		    Xen_list_1(C_string_to_Xen_string(S_apply_controls ": already applying controls")));
5340 	}
5341 
5342       if (Xen_is_llong(beg)) apply_beg = Xen_llong_to_C_llong(beg); else apply_beg = 0;
5343       if (Xen_is_llong(dur)) apply_dur = Xen_llong_to_C_llong(dur); else apply_dur = 0;
5344 
5345       if (Xen_is_integer(choice))
5346 	cur_choice = (snd_apply_t)Xen_integer_to_C_int(choice);
5347       if (cur_choice > APPLY_TO_SELECTION)
5348 	Xen_out_of_range_error(S_apply_controls, 2, choice, "choice must be 0=sound, 1=channel, or 2=selection");
5349 
5350       ss->apply_choice = cur_choice;
5351       sp->applying = true;
5352       ap = (apply_state *)make_apply_state(sp);
5353 
5354       if (ap)
5355 	{
5356 	  redirect_snd_error_to(apply_controls_error, (void *)S_apply_controls);
5357 	  redirect_snd_warning_to(squelch_printout, NULL);
5358 	  while (apply_controls(ap)) {};
5359 	  redirect_snd_warning_to(NULL, NULL); /* no-op message pointless within xen */
5360 	  redirect_snd_error_to(NULL, NULL);
5361 	}
5362       return(snd);
5363     }
5364   return(snd_no_such_sound_error(S_apply_controls, snd));
5365 }
5366 
5367 
5368 /* ---------------------------------------- peak env files ---------------------------------------- */
5369 
5370 static int pack_env_info_type(void)
5371 {
5372   /* put data description in peak-env info file (in case user opens it from incompatible machine) */
5373   int val = 0;
5374 #if MUS_LITTLE_ENDIAN
5375   val |= (1 << 8);
5376 #endif
5377   val |= (1 << 9); /* always float now */
5378   val |= (sizeof(mus_float_t) << 10);
5379   return(val);
5380 }
5381 
5382 
5383 static char *peak_clean(const char *name)
5384 {
5385   int len, i;
5386   char *peak_name;
5387   len = mus_strlen(name);
5388   peak_name = (char *)calloc(len + 1, sizeof(char));
5389   for (i = 0; i < len; i++)
5390     {
5391       if ((name[i] == '\\') ||
5392 	  (name[i] == '/'))
5393 	peak_name[i] = '_';
5394       else peak_name[i] = name[i];
5395     }
5396   return(peak_name);
5397 }
5398 
5399 
5400 static char *expanded_peak_name(const char *name, int chan)
5401 {
5402   char *fullname, *peak_file_name, *clean_name;
5403 
5404   clean_name = peak_clean(name);
5405   peak_file_name = mus_format("%s/%s-peaks-%d", peak_env_dir(ss), clean_name, chan);
5406   fullname = mus_expand_filename(peak_file_name);
5407 
5408   if (clean_name) free(clean_name);
5409   if (peak_file_name) free(peak_file_name);
5410   return(fullname);
5411 }
5412 
5413 
5414 void delete_peak_env_info_file(chan_info *cp)
5415 {
5416   char *fullname;
5417   fullname = expanded_peak_name(cp->sound->filename, cp->chan);
5418 
5419   if (mus_file_probe(fullname))
5420     remove(fullname);
5421 
5422   if (fullname) free(fullname);
5423 }
5424 
5425 
5426 #define PEAK_ENV_VERSION 0
5427 #define PEAK_ENV_INTS 5
5428 #define PEAK_ENV_SAMPS 2
5429 
5430 
5431 bool write_peak_env_info_file(chan_info *cp)
5432 {
5433   char *fullname;
5434   peak_env_info *ep;
5435   int fd;
5436   int ibuf[PEAK_ENV_INTS];
5437   mus_float_t mbuf[PEAK_ENV_SAMPS];
5438   ssize_t bytes;
5439 
5440   if (!(cp->edits)) return(true);
5441   ep = cp->edits[0]->peak_env;
5442   if (!ep) return(false);
5443 
5444   fullname = expanded_peak_name(cp->sound->filename, cp->chan);
5445   fd = mus_file_create(fullname);
5446   if (fd == -1)
5447     {
5448       if (fullname) free(fullname);
5449       return(false);
5450     }
5451 
5452   ibuf[0] = ((ep->completed) ? 1 : 0) | PEAK_ENV_VERSION | (pack_env_info_type() << 16);
5453   ibuf[1] = ep->peak_env_size;
5454   ibuf[2] = ep->samps_per_bin;
5455   ibuf[3] = ep->bin;
5456   ibuf[4] = ep->top_bin;
5457   mbuf[0] = ep->fmin;
5458   mbuf[1] = ep->fmax;
5459 
5460   bytes = write(fd, (char *)ibuf, (PEAK_ENV_INTS * sizeof(int)));
5461   if (bytes != 0) bytes = write(fd, (char *)mbuf, (PEAK_ENV_SAMPS * sizeof(mus_float_t)));
5462   if (bytes != 0) bytes = write(fd, (char *)(ep->data_min), (ep->peak_env_size * sizeof(mus_float_t)));
5463   if (bytes != 0) bytes = write(fd, (char *)(ep->data_max), (ep->peak_env_size * sizeof(mus_float_t)));
5464   if (bytes == 0) fprintf(stderr, "write error while writing peak env file");
5465 
5466   snd_close(fd, fullname);
5467   if (fullname) free(fullname);
5468   return(true);
5469 }
5470 
5471 
5472 typedef enum {PEAK_ENV_NO_ERROR, PEAK_ENV_BAD_HEADER, PEAK_ENV_BAD_FORMAT, PEAK_ENV_BAD_SIZE, PEAK_ENV_NO_FILE, PEAK_ENV_NO_DATA} peak_env_error_t;
5473 static const char *peak_env_error[6] = {
5474   "no error",
5475   "peak-env file has a bad header!",
5476   "peak-env file is in the wrong sample type; will re-make it.",
5477   "peak-env file size is messed up!",
5478   "peak-env file has vanished!",
5479   "peak-env file is empty!"};
5480 
5481 static bool peak_env_info_type_ok(int val)
5482 {
5483   return((val == 0) ||                            /* for backwards compatibility */
5484 	 (val == pack_env_info_type()));
5485 }
5486 
5487 
5488 static peak_env_info *get_peak_env_info(const char *fullname, peak_env_error_t *error)
5489 {
5490   peak_env_info *ep;
5491   int fd, hdr = 0;
5492   ssize_t bytes;
5493   int ibuf[PEAK_ENV_INTS];
5494   mus_float_t mbuf[PEAK_ENV_SAMPS];
5495 
5496   fd = mus_file_open_read(fullname);
5497   if (fd == -1)
5498     {
5499       (*error) = PEAK_ENV_NO_FILE;
5500       return(NULL);
5501     }
5502 
5503   bytes = read(fd, (char *)ibuf, (PEAK_ENV_INTS * sizeof(int)));
5504   if (bytes != (PEAK_ENV_INTS * sizeof(int)))
5505     {
5506       snd_close(fd, fullname);
5507       (*error) = PEAK_ENV_NO_DATA;
5508       return(NULL);
5509     }
5510 
5511   hdr = ibuf[0];
5512   (*error) = PEAK_ENV_NO_ERROR;
5513   if (((hdr & 0xf) != 0) && ((hdr & 0xf) != 1))
5514     (*error) = PEAK_ENV_BAD_HEADER;
5515   else
5516     {
5517       if (!(peak_env_info_type_ok(hdr >> 16)))
5518 	(*error) = PEAK_ENV_BAD_FORMAT;
5519       else
5520 	{
5521 	  if ((ibuf[1] <= 0) || (!(is_power_of_2(ibuf[1]))))
5522 	    (*error) = PEAK_ENV_BAD_SIZE;
5523 	  else
5524 	    {
5525 	      if ((ibuf[2] <= 0) || (ibuf[4] > ibuf[1]))
5526 		(*error) = PEAK_ENV_BAD_HEADER;
5527 	    }
5528 	}
5529     }
5530 
5531   if ((*error) != PEAK_ENV_NO_ERROR)
5532     {
5533       snd_close(fd, fullname);
5534       return(NULL);
5535     }
5536 
5537   ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
5538   ep->completed = (bool)(hdr & 0xf); /* version number in higher bits */
5539   ep->peak_env_size = ibuf[1];
5540   ep->samps_per_bin = ibuf[2];
5541   ep->bin = ibuf[3];
5542   ep->top_bin = ibuf[4];
5543 
5544   if (read(fd, (char *)mbuf, (PEAK_ENV_SAMPS * sizeof(mus_float_t))) == 0) fprintf(stderr, "%s: read error", fullname);
5545 
5546   ep->fmin = mbuf[0];
5547   ep->fmax = mbuf[1];
5548 
5549   ep->data_min = (mus_float_t *)malloc(ep->peak_env_size * sizeof(mus_float_t));
5550   ep->data_max = (mus_float_t *)malloc(ep->peak_env_size * sizeof(mus_float_t));
5551 
5552   if (read(fd, (char *)(ep->data_min), (ep->peak_env_size * sizeof(mus_float_t))) == 0) fprintf(stderr, "%s: read error", fullname);
5553   if (read(fd, (char *)(ep->data_max), (ep->peak_env_size * sizeof(mus_float_t))) == 0) fprintf(stderr, "%s: read error", fullname);
5554 
5555   snd_close(fd, fullname);
5556   return(ep);
5557 }
5558 
5559 
5560 const char *read_peak_env_info_file(chan_info *cp)
5561 {
5562   peak_env_error_t err = PEAK_ENV_NO_ERROR;
5563   char *fullname;
5564 
5565   if (!(cp->edits)) return(NULL);
5566 
5567   fullname = expanded_peak_name(cp->sound->filename, cp->chan);
5568   if (mus_file_probe(fullname))
5569     {
5570       if (file_write_date(fullname) > cp->sound->write_date)
5571 	cp->edits[0]->peak_env = get_peak_env_info(fullname, &err);
5572       else remove(fullname);
5573     }
5574   if (fullname) free(fullname);
5575 
5576   if ((!cp->edits[0]->peak_env) &&
5577       (err != PEAK_ENV_NO_ERROR))
5578     return(peak_env_error[(int)err]);
5579 
5580   return(NULL);
5581 }
5582 
5583 
5584 static Xen g_peak_env_info_to_vcts(peak_env_info *ep, int len)
5585 {
5586   /* changed 5-Jan-03 to return vcts */
5587   /* in snd-test this causes unfreed memory because the sound-icon-box saves all the data for each icon (vcts unfreed) */
5588   Xen res;
5589   int i, lim;
5590   vct *vmax, *vmin;
5591   mus_float_t *maxdata, *mindata;
5592   int loc;
5593 
5594   if ((len == 0) || (len > ep->peak_env_size))
5595     lim = ep->peak_env_size;
5596   else lim = len;
5597   if (lim <= 0) return(Xen_empty_list);
5598 
5599   res = Xen_list_2(xen_make_vct(lim, (mus_float_t *)calloc(lim, sizeof(mus_float_t))),
5600 		   xen_make_vct(lim, (mus_float_t *)calloc(lim, sizeof(mus_float_t))));
5601   loc = snd_protect(res);
5602 
5603   vmin = xen_to_vct(Xen_car(res));
5604   vmax = xen_to_vct(Xen_cadr(res));
5605   mindata = mus_vct_data(vmin);
5606   maxdata = mus_vct_data(vmax);
5607 
5608   if (ep->peak_env_size == lim)
5609     {
5610       for (i = 0; i < lim; i++)
5611 	{
5612 	  mindata[i] = ep->data_min[i];
5613 	  maxdata[i] = ep->data_max[i];
5614 	}
5615     }
5616   else
5617     {
5618       mus_float_t cmax, cmin, incr, x;
5619       int j;
5620       incr = (mus_float_t)(ep->peak_env_size - 1) / (mus_float_t)lim; /* make extra room on left */
5621       cmax = ep->fmin;
5622       cmin = ep->fmax;
5623       mindata[0] = ep->data_min[0];
5624       maxdata[0] = ep->data_max[0];
5625       for (i = 1, j = 1, x = 0.0; i < ep->peak_env_size; i++)
5626 	{
5627 	  if (ep->data_max[i] > cmax) cmax = ep->data_max[i];
5628 	  if (ep->data_min[i] < cmin) cmin = ep->data_min[i];
5629 	  x += 1.0;
5630 	  if (x >= incr)
5631 	    {
5632 	      mindata[j] = cmin;
5633 	      maxdata[j++] = cmax;
5634 	      x -= incr;
5635 	      cmax = ep->fmin;
5636 	      cmin = ep->fmax;
5637 	      if (j == lim) break;
5638 	    }
5639 	}
5640     }
5641   snd_unprotect_at(loc);
5642   return(res);
5643 }
5644 
5645 
5646 #if (!USE_NO_GUI)
5647 typedef struct {
5648   chan_info *cp;
5649   env_state *es;
5650   int len;
5651   Xen filename;
5652   Xen func;
5653   int func_gc_loc;
5654 } env_tick;
5655 
5656 static idle_func_t tick_it(any_pointer_t pet)
5657 {
5658   bool val;
5659   env_state *es;
5660   chan_info *cp;
5661   env_tick *et = (env_tick *)pet;
5662   es = et->es;
5663   cp = et->cp;
5664   val = tick_peak_env(cp, es);
5665   if (val)
5666     {
5667       es = free_env_state(es);
5668       if (Xen_is_procedure(et->func))
5669 	{
5670 	  int loc;
5671 	  Xen peak;
5672 	  peak = g_peak_env_info_to_vcts(cp->edits[0]->peak_env, et->len);
5673 	  loc = snd_protect(peak);
5674 	  Xen_call_with_3_args(et->func,
5675 		     et->filename,
5676 		     C_int_to_Xen_integer(cp->chan),
5677 		     peak,
5678 		     "amp env tick");
5679 	  snd_unprotect_at(et->func_gc_loc);
5680 	  snd_unprotect_at(loc);
5681 	}
5682       completely_free_snd_info(cp->sound);
5683       free(et);
5684       return(BACKGROUND_QUIT);
5685     }
5686   return(BACKGROUND_CONTINUE);
5687 }
5688 #endif
5689 
5690 
5691 static Xen g_channel_amp_envs(Xen filename, Xen chan, Xen pts, Xen peak_func, Xen done_func)
5692 {
5693   /* return two vectors of size pts containing y vals (min and max) of amp env
5694    *   if peak_func, use it to get peak_env_info file if needed
5695    *   if done_func set workproc that calls it when done
5696    */
5697   #define H_channel_amp_envs "(" S_channel_amp_envs " :optional file (chan 0) size peak-file-func work-proc-func): \
5698 return two " S_vct "s of length 'size' containing y vals (min and max) of file's channel chan's amp envs. \
5699 'peak-file-func' is used to get the name of the associated peak_env_info file if the file is very large. \
5700 'work-proc-func' is called when the amp envs are ready if the amp envs are gathered in the background. \
5701 If 'filename' is a sound index or a sound object, 'size' is interpreted as an edit-position, and the current amp envs are returned."
5702 
5703   char *fullname = NULL;
5704   int len = 0, chn = 0;
5705   snd_info *sp = NULL;
5706   chan_info *cp = NULL;
5707   peak_env_error_t err = PEAK_ENV_NO_ERROR;
5708 
5709   Xen_check_type(Xen_is_string(filename) || Xen_is_integer(filename) || !Xen_is_bound(filename) || xen_is_sound(filename),
5710 		  filename, 1, S_channel_amp_envs, "a string or sound index");
5711   Xen_check_type(Xen_is_integer_or_unbound(chan), chan, 2, S_channel_amp_envs, "an integer");
5712   Xen_check_type(Xen_is_integer_or_unbound(pts), pts, 3, S_channel_amp_envs, "an integer");
5713 
5714   Xen_check_type(((Xen_is_procedure(peak_func)) && (procedure_arity_ok(peak_func, 2))) ||
5715 		  (Xen_is_false(peak_func)) ||
5716 		  (!Xen_is_bound(peak_func)),
5717 		  peak_func, 4, S_channel_amp_envs, "a procedure of 2 args");
5718   Xen_check_type(((Xen_is_procedure(done_func)) && (procedure_arity_ok(done_func, 3))) ||
5719 		  (Xen_is_false(done_func)) ||
5720 		  (!Xen_is_bound(done_func)),
5721 		  done_func, 5, S_channel_amp_envs, "a procedure of 3 args");
5722 
5723   if (!(Xen_is_string(filename)))
5724     {
5725       cp = get_cp(filename, chan, S_channel_amp_envs);
5726       if (cp)
5727 	{
5728 	  env_state *es;
5729 	  peak_env_info *ep;
5730 	  int pos;
5731 
5732 	  pos = to_c_edit_position(cp, pts, S_channel_amp_envs, 3); /* here "pts" is edpos, not vector size */
5733 	  if (!cp->edits)
5734 	    return(Xen_empty_list);
5735 
5736 	  ep = cp->edits[pos]->peak_env; /* this can be null -- we run the peak envs if necessary */
5737 	  if ((ep) &&
5738 	      (ep->completed))
5739 	    return(g_peak_env_info_to_vcts(ep, ep->peak_env_size));
5740 
5741 	  /* force amp env to completion */
5742 	  stop_peak_env(cp);
5743 	  es = make_env_state(cp, cp->edits[pos]->samples);
5744 	  if (es)
5745 	    {
5746 	      while (!(tick_peak_env(cp, es))) {};
5747 	      free_env_state(es);
5748 	      ep = cp->edits[pos]->peak_env;
5749 	      if (ep)
5750 		return(g_peak_env_info_to_vcts(ep, ep->peak_env_size));
5751 	    }
5752 	  return(Xen_empty_list);
5753 	}
5754       /* else get_cp threw an error */
5755     }
5756 
5757   /* filename is a string from here down */
5758 
5759   fullname = mus_expand_filename(Xen_string_to_C_string(filename));
5760   if (Xen_is_integer(chan)) chn = Xen_integer_to_C_int(chan);
5761   if (chn < 0)
5762     Xen_out_of_range_error(S_channel_amp_envs, 2, chan, "must be >= 0");
5763   if (Xen_is_integer(pts)) len = Xen_integer_to_C_int(pts);
5764 
5765   /* look for sp->filename = fullname
5766      then peak
5767      then read direct (via make_sound_readable)
5768   */
5769 
5770   sp = find_sound(fullname, 0);
5771   if (sp)
5772     {
5773       if (chn < (int)sp->nchans)
5774 	{
5775 	  cp = sp->chans[chn];
5776 	  if (cp->edits[0]->peak_env)
5777 	    {
5778 	      if (fullname) free(fullname);
5779 	      /* here len can be 0 */
5780 	      return(g_peak_env_info_to_vcts(cp->edits[0]->peak_env, len));
5781 	    }
5782 	}
5783       else
5784 	{
5785 	  if (fullname) free(fullname);
5786 	  Xen_error(NO_SUCH_CHANNEL,
5787 		    Xen_list_3(C_string_to_Xen_string(S_channel_amp_envs ": no such channel (~A in ~S)"),
5788 			       chan,
5789 			       filename));
5790 	  return(Xen_false);
5791 	}
5792     }
5793 
5794   if (!(mus_file_probe(fullname)))
5795     {
5796       if (fullname) free(fullname);
5797       Xen_error(NO_SUCH_FILE,
5798 		Xen_list_2(C_string_to_Xen_string(S_channel_amp_envs ": no such file: ~S"),
5799 			   filename));
5800       return(Xen_false);
5801     }
5802   if (mus_sound_chans(fullname) < chn)
5803     {
5804       if (fullname) free(fullname);
5805       Xen_error(NO_SUCH_CHANNEL,
5806 		Xen_list_3(C_string_to_Xen_string(S_channel_amp_envs ": no such channel (~A in ~S)"),
5807 			   chan,
5808 			   filename));
5809       return(Xen_false);
5810     }
5811 
5812   if (Xen_is_procedure(peak_func))
5813     {
5814       Xen peak_filename;
5815       peak_filename = Xen_call_with_2_args(peak_func,
5816 				 filename,
5817 				 chan,
5818 				 "peak env filename procedure");
5819       if (Xen_is_string(peak_filename))
5820 	{
5821 	  char *peakname;
5822 	  peakname = mus_expand_filename(Xen_string_to_C_string(peak_filename));
5823 	  if (mus_file_probe(peakname))
5824 	    {
5825 	      peak_env_info *ep;
5826 	      ep = get_peak_env_info(peakname, &err);
5827 	      if (ep)
5828 		{
5829 		  Xen vcts;
5830 		  vcts = g_peak_env_info_to_vcts(ep, len);
5831 		  free_peak_env_info(ep);
5832 		  if (peakname) free(peakname);
5833 		  if (fullname) free(fullname);
5834 		  return(vcts);
5835 		}
5836 	    }
5837 	  /* the else side (no such file) could be considered a request to make the peak env file (i.e. not necessarily an error) */
5838 	  if (peakname) {free(peakname); peakname = NULL;}
5839 	}
5840     }
5841 
5842   /* now set up to read direct... */
5843   sp = make_sound_readable(fullname, false);
5844   if (fullname) free(fullname);
5845   fullname = NULL;
5846   if ((sp) &&
5847       (chn < (int)sp->nchans))
5848     {
5849       cp = sp->chans[chn];
5850       if (cp)
5851 	{
5852 	  Xen peak = Xen_false;
5853 	  env_state *es;
5854 	  es = make_env_state(cp, cp->edits[0]->samples);
5855 	  if (es)
5856 	    {
5857 #if (!USE_NO_GUI)
5858 	      if (Xen_is_procedure(done_func))
5859 		{
5860 		  int id;
5861 		  env_tick *et;
5862 
5863 		  if (len <= 0)
5864 		    Xen_out_of_range_error(S_channel_amp_envs, 3, pts, "must be > 0");
5865 
5866 		  et = (env_tick *)calloc(1, sizeof(env_tick));
5867 		  et->cp = cp;
5868 		  et->es = es;
5869 		  et->func = done_func;
5870 		  et->func_gc_loc = snd_protect(done_func);
5871 		  et->len = len;
5872 		  et->filename = filename;
5873 		  id = (int)BACKGROUND_ADD(tick_it, (any_pointer_t)et);
5874 		  return(C_int_to_Xen_integer(id));
5875 		}
5876 #endif
5877 	      while (!(tick_peak_env(cp, es))) {};
5878 	      free_env_state(es);
5879 	      peak = g_peak_env_info_to_vcts(cp->edits[0]->peak_env, len);
5880 	    }
5881 	  cp->active = CHANNEL_INACTIVE;
5882 	  completely_free_snd_info(sp);
5883 	  return(peak);
5884 	}
5885     }
5886   return(Xen_false);
5887 }
5888 
5889 /* -------------------------------------------------------------------------------- */
5890 
5891 
5892 static Xen g_start_progress_report(Xen snd, Xen chn)
5893 {
5894   #define H_start_progress_report "(" S_start_progress_report " :optional snd chn): post the hour-glass icon"
5895   chan_info *cp;
5896 
5897   Snd_assert_channel(S_start_progress_report, snd, chn, 1);
5898   cp = get_cp(snd, chn, S_start_progress_report);
5899   if (!cp)
5900     return(snd_no_such_channel_error(S_start_progress_report, snd, chn));
5901 
5902   start_progress_report(cp);
5903 
5904   return(Xen_true);
5905 }
5906 
5907 
5908 static Xen g_finish_progress_report(Xen snd, Xen chn)
5909 {
5910   #define H_finish_progress_report "(" S_finish_progress_report " :optional snd chn): remove the hour-glass icon"
5911   chan_info *cp;
5912 
5913   Snd_assert_channel(S_finish_progress_report, snd, chn, 1);
5914   cp = get_cp(snd, chn, S_finish_progress_report);
5915   if (!cp)
5916     return(snd_no_such_channel_error(S_finish_progress_report, snd, chn));
5917 
5918   finish_progress_report(cp);
5919 
5920   return(Xen_false);
5921 }
5922 
5923 
5924 static Xen g_progress_report(Xen pct, Xen snd, Xen chn)
5925 {
5926   #define H_progress_report "(" S_progress_report " pct :optional snd chn): \
5927 update an on-going 'progress report' (an animated hour-glass icon) in snd's channel chn using pct to indicate how far along we are"
5928   chan_info *cp;
5929 
5930   Snd_assert_channel(S_progress_report, snd, chn, 2);
5931   cp = get_cp(snd, chn, S_progress_report);
5932   if (!cp)
5933     return(snd_no_such_channel_error(S_progress_report, snd, chn));
5934 
5935   Xen_check_type(Xen_is_number(pct), pct, 1, S_progress_report, "a number");
5936 
5937   progress_report(cp, Xen_real_to_C_double(pct));
5938   return(pct);
5939 }
5940 
5941 
5942 static Xen g_sounds(void)
5943 {
5944   #define H_sounds "(" S_sounds "): list of active sounds"
5945   int i;
5946   Xen result;
5947   result = Xen_empty_list;
5948   for (i = 0; i < ss->max_sounds; i++)
5949     {
5950       snd_info *sp;
5951       sp = ss->sounds[i];
5952       if ((sp) && (sp->inuse == SOUND_NORMAL))
5953 	result = Xen_cons(C_int_to_Xen_sound(i),
5954 			  result);
5955     }
5956   return(result);
5957 }
5958 
5959 
5960 static Xen g_status_report(Xen msg, Xen snd)
5961 {
5962   #define H_status_report "(" S_status_report " message :optional snd) posts message in snd's status area.\
5963 If 'snd' is not a currently open sound, the message is sent to the listener, if it is open. \
5964 If there is no sound or listener, it is sent to stderr."
5965 
5966   snd_info *sp;
5967   const char *message;
5968 
5969   Xen_check_type(Xen_is_string(msg), msg, 1, S_status_report, "a string");
5970   Snd_assert_sound(S_status_report, snd, 2);
5971 
5972   message = Xen_string_to_C_string(msg);
5973   sp = get_sp(snd);
5974 
5975   if ((!sp) ||
5976       (sp->inuse != SOUND_NORMAL))
5977     {
5978       if ((message) && (*message))
5979 	{
5980 	  if (listener_exists())
5981 	    append_listener_text(-1, message);
5982 	  else fprintf(stderr, "%s", message);
5983 	}
5984     }
5985   else
5986     {
5987       if ((message) && (*message))
5988 	set_status(sp, message, false);
5989       else clear_status_area(sp);
5990     }
5991   return(msg);
5992 }
5993 
5994 
5995 Xen_wrap_1_arg(g_is_sound_w, g_is_sound)
5996 Xen_wrap_2_optional_args(g_find_sound_w, g_find_sound)
5997 Xen_wrap_1_optional_arg(g_channels_w, g_channels)
5998 Xen_wrap_2_optional_args(g_set_channels_w, g_set_channels)
5999 Xen_wrap_1_optional_arg(g_srate_w, g_srate)
6000 Xen_wrap_2_optional_args(g_set_srate_w, g_set_srate)
6001 Xen_wrap_1_optional_arg(g_data_location_w, g_data_location)
6002 Xen_wrap_2_optional_args(g_set_data_location_w, g_set_data_location)
6003 Xen_wrap_1_optional_arg(g_data_size_w, g_data_size)
6004 Xen_wrap_2_optional_args(g_set_data_size_w, g_set_data_size)
6005 Xen_wrap_1_optional_arg(g_sample_type_w, g_sample_type)
6006 Xen_wrap_2_optional_args(g_set_sample_type_w, g_set_sample_type)
6007 Xen_wrap_1_optional_arg(g_header_type_w, g_header_type)
6008 Xen_wrap_2_optional_args(g_set_header_type_w, g_set_header_type)
6009 Xen_wrap_1_optional_arg(g_comment_w, g_comment)
6010 Xen_wrap_2_optional_args(g_set_comment_w, g_set_comment)
6011 Xen_wrap_1_optional_arg(g_file_name_w, g_file_name)
6012 Xen_wrap_1_optional_arg(g_short_file_name_w, g_short_file_name)
6013 Xen_wrap_1_optional_arg(g_save_controls_w, g_save_controls)
6014 Xen_wrap_1_optional_arg(g_restore_controls_w, g_restore_controls)
6015 Xen_wrap_1_optional_arg(g_reset_controls_w, g_reset_controls)
6016 Xen_wrap_no_args(g_selected_sound_w, g_selected_sound)
6017 Xen_wrap_1_optional_arg(g_selected_channel_w, g_selected_channel)
6018 Xen_wrap_2_optional_args(g_set_selected_channel_w, g_set_selected_channel)
6019 Xen_wrap_1_arg(g_select_sound_w, g_select_sound)
6020 Xen_wrap_1_optional_arg(g_select_channel_w, g_select_channel)
6021 Xen_wrap_1_optional_arg(g_close_sound_w, g_close_sound)
6022 Xen_wrap_1_optional_arg(g_update_sound_w, g_update_sound)
6023 Xen_wrap_1_optional_arg(g_save_sound_w, g_save_sound)
6024 Xen_wrap_1_arg(g_open_sound_w, g_open_sound)
6025 Xen_wrap_1_arg(g_view_sound_w, g_view_sound)
6026 Xen_wrap_1_optional_arg(g_revert_sound_w, g_revert_sound)
6027 Xen_wrap_4_optional_args(g_apply_controls_w, g_apply_controls)
6028 Xen_wrap_6_optional_args(g_controls_to_channel_w, g_controls_to_channel)
6029 Xen_wrap_1_optional_arg(g_filter_control_envelope_w, g_filter_control_envelope)
6030 Xen_wrap_1_optional_arg(g_show_controls_w, g_show_controls)
6031 Xen_wrap_1_optional_arg(g_sync_w, g_sync)
6032 Xen_wrap_no_args(g_sync_max_w, g_sync_max)
6033 Xen_wrap_1_optional_arg(g_sound_properties_w, g_sound_properties)
6034 Xen_wrap_2_optional_args(g_sound_property_w, g_sound_property)
6035 Xen_wrap_1_optional_arg(g_channel_style_w, g_channel_style)
6036 Xen_wrap_1_optional_arg(g_read_only_w, g_read_only)
6037 Xen_wrap_1_optional_arg(g_expand_control_on_w, g_expand_control_on)
6038 Xen_wrap_1_optional_arg(g_contrast_control_on_w, g_contrast_control_on)
6039 Xen_wrap_1_optional_arg(g_reverb_control_on_w, g_reverb_control_on)
6040 Xen_wrap_1_optional_arg(g_filter_control_on_w, g_filter_control_on)
6041 Xen_wrap_1_optional_arg(g_filter_control_in_dB_w, g_filter_control_in_dB)
6042 Xen_wrap_1_optional_arg(g_filter_control_in_hz_w, g_filter_control_in_hz)
6043 Xen_wrap_1_optional_arg(g_filter_control_coeffs_w, g_filter_control_coeffs)
6044 Xen_wrap_1_optional_arg(g_filter_control_order_w, g_filter_control_order)
6045 Xen_wrap_1_optional_arg(g_contrast_control_w, g_contrast_control)
6046 Xen_wrap_1_optional_arg(g_contrast_control_bounds_w, g_contrast_control_bounds)
6047 Xen_wrap_1_optional_arg(g_contrast_control_amp_w, g_contrast_control_amp)
6048 Xen_wrap_1_optional_arg(g_expand_control_w, g_expand_control)
6049 Xen_wrap_1_optional_arg(g_expand_control_bounds_w, g_expand_control_bounds)
6050 Xen_wrap_1_optional_arg(g_expand_control_length_w, g_expand_control_length)
6051 Xen_wrap_1_optional_arg(g_expand_control_ramp_w, g_expand_control_ramp)
6052 Xen_wrap_1_optional_arg(g_expand_control_hop_w, g_expand_control_hop)
6053 Xen_wrap_1_optional_arg(g_expand_control_jitter_w, g_expand_control_jitter)
6054 Xen_wrap_1_optional_arg(g_speed_control_w, g_speed_control)
6055 Xen_wrap_1_optional_arg(g_speed_control_bounds_w, g_speed_control_bounds)
6056 Xen_wrap_1_optional_arg(g_reverb_control_length_w, g_reverb_control_length)
6057 Xen_wrap_1_optional_arg(g_reverb_control_length_bounds_w, g_reverb_control_length_bounds)
6058 Xen_wrap_1_optional_arg(g_reverb_control_scale_w, g_reverb_control_scale)
6059 Xen_wrap_1_optional_arg(g_reverb_control_scale_bounds_w, g_reverb_control_scale_bounds)
6060 Xen_wrap_1_optional_arg(g_reverb_control_feedback_w, g_reverb_control_feedback)
6061 Xen_wrap_1_optional_arg(g_reverb_control_lowpass_w, g_reverb_control_lowpass)
6062 Xen_wrap_2_optional_args(g_amp_control_w, g_amp_control)
6063 Xen_wrap_1_optional_arg(g_amp_control_bounds_w, g_amp_control_bounds)
6064 Xen_wrap_1_optional_arg(g_reverb_control_decay_w, g_reverb_control_decay)
6065 Xen_wrap_1_optional_arg(g_speed_control_style_w, g_speed_control_style)
6066 Xen_wrap_1_optional_arg(g_speed_control_tones_w, g_speed_control_tones)
6067 Xen_wrap_5_optional_args(g_channel_amp_envs_w, g_channel_amp_envs);
6068 Xen_wrap_2_optional_args(g_start_progress_report_w, g_start_progress_report)
6069 Xen_wrap_2_optional_args(g_finish_progress_report_w, g_finish_progress_report)
6070 Xen_wrap_3_optional_args(g_progress_report_w, g_progress_report)
6071 Xen_wrap_no_args(g_sounds_w, g_sounds)
6072 Xen_wrap_1_arg(g_integer_to_sound_w, g_integer_to_sound)
6073 Xen_wrap_1_arg(g_sound_to_integer_w, g_sound_to_integer)
6074 Xen_wrap_2_optional_args(g_status_report_w, g_status_report)
6075 #if HAVE_SCHEME
6076 #define g_set_filter_control_envelope_w g_set_filter_control_envelope_reversed
6077 #define g_set_read_only_w g_set_read_only_reversed
6078 #define g_set_sound_properties_w g_set_sound_properties_reversed
6079 #define g_set_sound_property_w g_set_sound_property_reversed
6080 #define g_set_sync_w g_set_sync_reversed
6081 #define g_set_channel_style_w g_set_channel_style_reversed
6082 #define g_set_show_controls_w g_set_show_controls_reversed
6083 #define g_set_expand_control_on_w g_set_expand_control_on_reversed
6084 #define g_set_contrast_control_on_w g_set_contrast_control_on_reversed
6085 #define g_set_reverb_control_on_w g_set_reverb_control_on_reversed
6086 #define g_set_filter_control_on_w g_set_filter_control_on_reversed
6087 #define g_set_filter_control_in_dB_w g_set_filter_control_in_dB_reversed
6088 #define g_set_filter_control_in_hz_w g_set_filter_control_in_hz_reversed
6089 #define g_set_filter_control_order_w g_set_filter_control_order_reversed
6090 #define g_set_contrast_control_w g_set_contrast_control_reversed
6091 #define g_set_contrast_control_bounds_w g_set_contrast_control_bounds_reversed
6092 #define g_set_contrast_control_amp_w g_set_contrast_control_amp_reversed
6093 #define g_set_expand_control_w g_set_expand_control_reversed
6094 #define g_set_expand_control_bounds_w g_set_expand_control_bounds_reversed
6095 #define g_set_expand_control_length_w g_set_expand_control_length_reversed
6096 #define g_set_expand_control_ramp_w g_set_expand_control_ramp_reversed
6097 #define g_set_expand_control_hop_w g_set_expand_control_hop_reversed
6098 #define g_set_expand_control_jitter_w g_set_expand_control_jitter_reversed
6099 #define g_set_speed_control_w g_set_speed_control_reversed
6100 #define g_set_speed_control_bounds_w g_set_speed_control_bounds_reversed
6101 #define g_set_reverb_control_length_w g_set_reverb_control_length_reversed
6102 #define g_set_reverb_control_length_bounds_w g_set_reverb_control_length_bounds_reversed
6103 #define g_set_reverb_control_scale_w g_set_reverb_control_scale_reversed
6104 #define g_set_reverb_control_scale_bounds_w g_set_reverb_control_scale_bounds_reversed
6105 #define g_set_reverb_control_feedback_w g_set_reverb_control_feedback_reversed
6106 #define g_set_reverb_control_lowpass_w g_set_reverb_control_lowpass_reversed
6107 #define g_set_amp_control_w g_set_amp_control_reversed
6108 #define g_set_amp_control_bounds_w g_set_amp_control_bounds_reversed
6109 #define g_set_reverb_control_decay_w g_set_reverb_control_decay_reversed
6110 #define g_set_speed_control_style_w g_set_speed_control_style_reversed
6111 #define g_set_speed_control_tones_w g_set_speed_control_tones_reversed
6112 #else
6113 Xen_wrap_any_args(g_save_sound_as_w, g_save_sound_as)
6114 Xen_wrap_any_args(g_new_sound_w, g_new_sound)
6115 Xen_wrap_any_args(g_open_raw_sound_w, g_open_raw_sound)
6116 Xen_wrap_2_optional_args(g_set_filter_control_envelope_w, g_set_filter_control_envelope)
6117 Xen_wrap_2_optional_args(g_set_read_only_w, g_set_read_only)
6118 Xen_wrap_2_optional_args(g_set_sound_properties_w, g_set_sound_properties)
6119 Xen_wrap_3_optional_args(g_set_sound_property_w, g_set_sound_property)
6120 Xen_wrap_2_optional_args(g_set_sync_w, g_set_sync)
6121 Xen_wrap_2_optional_args(g_set_channel_style_w, g_set_channel_style)
6122 Xen_wrap_2_optional_args(g_set_show_controls_w, g_set_show_controls)
6123 Xen_wrap_2_optional_args(g_set_expand_control_on_w, g_set_expand_control_on)
6124 Xen_wrap_2_optional_args(g_set_contrast_control_on_w, g_set_contrast_control_on)
6125 Xen_wrap_2_optional_args(g_set_reverb_control_on_w, g_set_reverb_control_on)
6126 Xen_wrap_2_optional_args(g_set_filter_control_on_w, g_set_filter_control_on)
6127 Xen_wrap_2_optional_args(g_set_filter_control_in_dB_w, g_set_filter_control_in_dB)
6128 Xen_wrap_2_optional_args(g_set_filter_control_in_hz_w, g_set_filter_control_in_hz)
6129 Xen_wrap_2_optional_args(g_set_filter_control_order_w, g_set_filter_control_order)
6130 Xen_wrap_2_optional_args(g_set_contrast_control_w, g_set_contrast_control)
6131 Xen_wrap_2_optional_args(g_set_contrast_control_bounds_w, g_set_contrast_control_bounds)
6132 Xen_wrap_2_optional_args(g_set_contrast_control_amp_w, g_set_contrast_control_amp)
6133 Xen_wrap_2_optional_args(g_set_expand_control_w, g_set_expand_control)
6134 Xen_wrap_2_optional_args(g_set_expand_control_bounds_w, g_set_expand_control_bounds)
6135 Xen_wrap_2_optional_args(g_set_expand_control_length_w, g_set_expand_control_length)
6136 Xen_wrap_2_optional_args(g_set_expand_control_ramp_w, g_set_expand_control_ramp)
6137 Xen_wrap_2_optional_args(g_set_expand_control_hop_w, g_set_expand_control_hop)
6138 Xen_wrap_2_optional_args(g_set_expand_control_jitter_w, g_set_expand_control_jitter)
6139 Xen_wrap_2_optional_args(g_set_speed_control_w, g_set_speed_control)
6140 Xen_wrap_2_optional_args(g_set_speed_control_bounds_w, g_set_speed_control_bounds)
6141 Xen_wrap_2_optional_args(g_set_reverb_control_length_w, g_set_reverb_control_length)
6142 Xen_wrap_2_optional_args(g_set_reverb_control_length_bounds_w, g_set_reverb_control_length_bounds)
6143 Xen_wrap_2_optional_args(g_set_reverb_control_scale_w, g_set_reverb_control_scale)
6144 Xen_wrap_2_optional_args(g_set_reverb_control_scale_bounds_w, g_set_reverb_control_scale_bounds)
6145 Xen_wrap_2_optional_args(g_set_reverb_control_feedback_w, g_set_reverb_control_feedback)
6146 Xen_wrap_2_optional_args(g_set_reverb_control_lowpass_w, g_set_reverb_control_lowpass)
6147 Xen_wrap_3_optional_args(g_set_amp_control_w, g_set_amp_control)
6148 Xen_wrap_2_optional_args(g_set_amp_control_bounds_w, g_set_amp_control_bounds)
6149 Xen_wrap_2_optional_args(g_set_reverb_control_decay_w, g_set_reverb_control_decay)
6150 Xen_wrap_2_optional_args(g_set_speed_control_style_w, g_set_speed_control_style)
6151 Xen_wrap_2_optional_args(g_set_speed_control_tones_w, g_set_speed_control_tones)
6152 #endif
6153 
6154 #if HAVE_SCHEME
6155 static s7_pointer acc_channel_style(s7_scheme *sc, s7_pointer args) {return(g_set_channel_style(s7_cadr(args), s7_undefined(sc)));}
6156 static s7_pointer acc_filter_control_in_dB(s7_scheme *sc, s7_pointer args) {return(g_set_filter_control_in_dB(s7_cadr(args), s7_undefined(sc)));}
6157 static s7_pointer acc_filter_control_in_hz(s7_scheme *sc, s7_pointer args) {return(g_set_filter_control_in_hz(s7_cadr(args), s7_undefined(sc)));}
6158 static s7_pointer acc_speed_control_tones(s7_scheme *sc, s7_pointer args) {return(g_set_speed_control_tones(s7_cadr(args), s7_undefined(sc)));}
6159 static s7_pointer acc_speed_control_style(s7_scheme *sc, s7_pointer args) {return(g_set_speed_control_style(s7_cadr(args), s7_undefined(sc)));}
6160 static s7_pointer acc_expand_control_length(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_length(s7_cadr(args), s7_undefined(sc)));}
6161 static s7_pointer acc_expand_control_ramp(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_ramp(s7_cadr(args), s7_undefined(sc)));}
6162 static s7_pointer acc_expand_control_hop(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_hop(s7_cadr(args), s7_undefined(sc)));}
6163 static s7_pointer acc_expand_control_jitter(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_jitter(s7_cadr(args), s7_undefined(sc)));}
6164 static s7_pointer acc_contrast_control_amp(s7_scheme *sc, s7_pointer args) {return(g_set_contrast_control_amp(s7_cadr(args), s7_undefined(sc)));}
6165 static s7_pointer acc_reverb_control_feedback(s7_scheme *sc, s7_pointer args) {return(g_set_reverb_control_feedback(s7_cadr(args), s7_undefined(sc)));}
6166 static s7_pointer acc_reverb_control_lowpass(s7_scheme *sc, s7_pointer args) {return(g_set_reverb_control_lowpass(s7_cadr(args), s7_undefined(sc)));}
6167 static s7_pointer acc_reverb_control_decay(s7_scheme *sc, s7_pointer args) {return(g_set_reverb_control_decay(s7_cadr(args), s7_undefined(sc)));}
6168 static s7_pointer acc_filter_control_order(s7_scheme *sc, s7_pointer args) {return(g_set_filter_control_order(s7_cadr(args), s7_undefined(sc)));}
6169 static s7_pointer acc_show_controls(s7_scheme *sc, s7_pointer args) {return(g_set_show_controls(s7_cadr(args), s7_undefined(sc)));}
6170 #endif
6171 
6172 
6173 void g_init_snd(void)
6174 {
6175 #if HAVE_SCHEME
6176   s7_pointer pl_iq, pl_iqi, pl_sq, pl_sts, pl_i, pl_osi, pl_bt, pl_bo, pl_bob, pl_io, pl_ioi, pl_po, pl_pop, pl_ro, pl_ror, pl_oi, pl_ioz, pl_roo, pl_roor;
6177   s7_pointer i, t, s, b, o, q, p, r, z, sd, fv;
6178   i = s7_make_symbol(s7, "integer?");
6179   s = s7_make_symbol(s7, "string?");
6180   b = s7_make_symbol(s7, "boolean?");
6181   p = s7_make_symbol(s7, "pair?");
6182   r = s7_make_symbol(s7, "real?");
6183   sd = s7_make_symbol(s7, "sound?");
6184   fv = s7_make_symbol(s7, "float-vector?");
6185   t = s7_t(s7);
6186   q = t; /* sigh -- #t is legal here which is idiotic */
6187   o = t;
6188   z = s7_make_signature(s7, 2, i, b);
6189   pl_i = s7_make_signature(s7, 1, i);
6190   pl_iq = s7_make_signature(s7, 2, i, q);
6191   pl_iqi = s7_make_signature(s7, 3, i, q, i);
6192   pl_sts = s7_make_signature(s7, 3, s, t, s);
6193   pl_sq = s7_make_signature(s7, 2, s, q);
6194   pl_osi = s7_make_signature(s7, 3, o, s, i);
6195   pl_bt = s7_make_signature(s7, 2, b, t);
6196   pl_bo = s7_make_signature(s7, 2, b, o);
6197   pl_bob = s7_make_signature(s7, 3, b, o, b);
6198   pl_io = s7_make_signature(s7, 2, i, o);
6199   pl_oi = s7_make_signature(s7, 2, o, i);
6200   pl_ioi = s7_make_signature(s7, 3, i, o, i);
6201   pl_ioz = s7_make_signature(s7, 3, i, o, z);
6202   pl_po = s7_make_signature(s7, 2, p, o);
6203   pl_pop = s7_make_signature(s7, 3, p, o, p);
6204   pl_ro = s7_make_signature(s7, 2, r, o);
6205   pl_ror = s7_make_signature(s7, 3, r, o, r);
6206   pl_roo = s7_make_signature(s7, 3, r, o, o);
6207   pl_roor = s7_make_signature(s7, 4, r, o, o, r);
6208 #endif
6209 
6210   init_xen_sound();
6211 #if (!HAVE_SCHEME)
6212   init_sound_keywords();
6213 #endif
6214 
6215   #define H_name_click_hook S_name_click_hook " (snd): called when sound name clicked. \
6216 If it returns " PROC_TRUE ", the usual informative status babbling is squelched."
6217 
6218   #define H_after_apply_controls_hook S_after_apply_controls_hook " (snd): called when " S_apply_controls " finishes."
6219 
6220   name_click_hook =           Xen_define_hook(S_name_click_hook,           "(make-hook 'snd)",      1, H_name_click_hook);
6221   after_apply_controls_hook = Xen_define_hook(S_after_apply_controls_hook, "(make-hook 'snd)",      1, H_after_apply_controls_hook);
6222 
6223   #define H_channels_separate "The value for " S_channel_style " that causes channel graphs to occupy separate panes"
6224   #define H_channels_combined "The value for " S_channel_style " that causes channel graphs to occupy one pane (set by the 'unite' button)"
6225   #define H_channels_superimposed "The value for " S_channel_style " that causes channel graphs to occupy one pane and one axis"
6226 
6227   Xen_define_constant(S_channels_separate,     CHANNELS_SEPARATE,     H_channels_separate);
6228   Xen_define_constant(S_channels_combined,     CHANNELS_COMBINED,     H_channels_combined);
6229   Xen_define_constant(S_channels_superimposed, CHANNELS_SUPERIMPOSED, H_channels_superimposed);
6230 
6231   Xen_define_typed_procedure(S_status_report,          g_status_report_w,          1, 1, 0, H_status_report, pl_sts);
6232 
6233   Xen_define_typed_dilambda(S_channels,      g_channels_w,      H_channels,      S_set S_channels,      g_set_channels_w,       0, 1, 1, 1, pl_iq, pl_iqi);
6234   Xen_define_typed_dilambda(S_chans,         g_channels_w,      H_channels,      S_set S_chans,         g_set_channels_w,       0, 1, 1, 1, pl_iq, pl_iqi);
6235   Xen_define_typed_dilambda(S_srate,         g_srate_w,         H_srate,         S_set S_srate,         g_set_srate_w,          0, 1, 1, 1, pl_iq, pl_iqi);
6236   Xen_define_typed_dilambda(S_data_location, g_data_location_w, H_data_location, S_set S_data_location, g_set_data_location_w,  0, 1, 1, 1, pl_iq, pl_iqi);
6237   Xen_define_typed_dilambda(S_data_size,     g_data_size_w,     H_data_size,     S_set S_data_size,     g_set_data_size_w,      0, 1, 1, 1, pl_iq, pl_iqi);
6238   Xen_define_typed_dilambda(S_sample_type,   g_sample_type_w,   H_sample_type,   S_set S_sample_type,   g_set_sample_type_w,    0, 1, 1, 1, pl_iq, pl_iqi);
6239   Xen_define_typed_dilambda(S_header_type,   g_header_type_w,   H_header_type,   S_set S_header_type,   g_set_header_type_w,    0, 1, 1, 1, pl_iq, pl_iqi);
6240   Xen_define_typed_dilambda(S_comment,       g_comment_w,       H_comment,       S_set S_comment,       g_set_comment_w,        0, 1, 1, 1, NULL, NULL);
6241 
6242   Xen_define_typed_procedure(S_is_sound,             g_is_sound_w,         1, 0, 0, H_is_sound,		pl_bt);
6243   Xen_define_typed_procedure(S_find_sound,           g_find_sound_w,       1, 1, 0, H_find_sound,	pl_osi);
6244   Xen_define_typed_procedure(S_file_name,            g_file_name_w,        0, 1, 0, H_file_name,	pl_sq);
6245   Xen_define_typed_procedure(S_short_file_name,      g_short_file_name_w,  0, 1, 0, H_short_file_name,	pl_sq);
6246   Xen_define_typed_procedure(S_save_controls,        g_save_controls_w,    0, 1, 0, H_save_controls,	pl_bt);
6247   Xen_define_typed_procedure(S_restore_controls,     g_restore_controls_w, 0, 1, 0, H_restore_controls, pl_bt);
6248   Xen_define_typed_procedure(S_reset_controls,       g_reset_controls_w,   0, 1, 0, H_reset_controls,	pl_bt);
6249   Xen_define_typed_procedure(S_select_sound,         g_select_sound_w,     1, 0, 0, H_select_sound,     s7_make_signature(s7, 2, sd, i));
6250   Xen_define_typed_procedure(S_select_channel,       g_select_channel_w,   0, 1, 0, H_select_channel,   s7_make_signature(s7, 2, i, i));
6251   Xen_define_typed_procedure(S_sync_max,             g_sync_max_w,         0, 0, 0, H_sync_max,	        pl_i);
6252   Xen_define_typed_procedure(S_filter_control_coeffs, g_filter_control_coeffs_w, 0, 1, 0, H_filter_control_coeffs, s7_make_signature(s7, 2, fv, sd));
6253 
6254   Xen_define_typed_dilambda(S_selected_sound, g_selected_sound_w, H_selected_sound,
6255 			    S_set S_selected_sound, g_select_sound_w,  0, 0, 1, 0,
6256 			    s7_make_signature(s7, 1, s7_make_signature(s7, 2, sd, b)), s7_make_signature(s7, 2, sd, z));
6257   Xen_define_typed_dilambda(S_selected_channel, g_selected_channel_w, H_selected_channel,
6258 			    S_set S_selected_channel, g_set_selected_channel_w,  0, 1, 0, 2,
6259 			    s7_make_signature(s7, 2, z, sd), s7_make_signature(s7, 3, i, t, z));
6260 
6261   Xen_define_typed_procedure(S_start_progress_report,  g_start_progress_report_w,   0, 2, 0, H_start_progress_report,  s7_make_signature(s7, 3, b, sd, i));
6262   Xen_define_typed_procedure(S_finish_progress_report, g_finish_progress_report_w,  0, 2, 0, H_finish_progress_report, s7_make_signature(s7, 3, b, sd, i));
6263   Xen_define_typed_procedure(S_progress_report,        g_progress_report_w,         1, 2, 0, H_progress_report,        s7_make_signature(s7, 4, r, r, sd, i));
6264 
6265   /* open-sound is definitely not a safe procedure; probably the rest of these are similar
6266    *   [see snd-test 5 with tests=2 or more]
6267    */
6268   Xen_define_unsafe_typed_procedure(S_close_sound,    g_close_sound_w,        0, 1, 0, H_close_sound,       s7_make_signature(s7, 2, t, t));
6269   Xen_define_unsafe_typed_procedure(S_update_sound,   g_update_sound_w,       0, 1, 0, H_update_sound,      s7_make_signature(s7, 2, t, t));
6270   Xen_define_unsafe_typed_procedure(S_save_sound,     g_save_sound_w,         0, 1, 0, H_save_sound,        s7_make_signature(s7, 2, sd, t));
6271   Xen_define_unsafe_typed_procedure(S_open_sound,     g_open_sound_w,         1, 0, 0, H_open_sound,        s7_make_signature(s7, 2, sd, s));
6272   Xen_define_unsafe_typed_procedure(S_view_sound,     g_view_sound_w,         1, 0, 0, H_view_sound,        s7_make_signature(s7, 2, sd, s));
6273   Xen_define_unsafe_typed_procedure(S_revert_sound,   g_revert_sound_w,       0, 1, 0, H_revert_sound,      s7_make_signature(s7, 2, sd, sd));
6274 
6275 #if HAVE_SCHEME
6276   s7_define_function_star(s7, S_new_sound, g_new_sound, "file channels srate sample-type header-type comment size", H_new_sound);
6277   s7_define_function_star(s7, S_save_sound_as, g_save_sound_as, "file sound srate sample-type header-type channel edit-position comment", H_save_sound_as);
6278   s7_define_function_star(s7, S_open_raw_sound, g_open_raw_sound, "file channels srate sample-type", H_open_raw_sound);
6279 #else
6280   Xen_define_unsafe_typed_procedure(S_new_sound,      g_new_sound_w,          0, 0, 1, H_new_sound,         s7_make_circular_signature(s7, 0, 1, t));
6281   Xen_define_unsafe_typed_procedure(S_open_raw_sound, g_open_raw_sound_w,     0, 0, 1, H_open_raw_sound,    s7_make_circular_signature(s7, 0, 1, t));
6282   Xen_define_unsafe_typed_procedure(S_save_sound_as,  g_save_sound_as_w,      0, 0, 1, H_save_sound_as,     s7_make_circular_signature(s7, 0, 1, t));
6283 #endif
6284 
6285   Xen_define_typed_procedure(S_apply_controls,         g_apply_controls_w,          0, 4, 0, H_apply_controls,         s7_make_signature(s7, 5, t, t, i, i, i));
6286   Xen_define_typed_procedure(S_controls_to_channel,    g_controls_to_channel_w,     0, 6, 0, H_controls_to_channel,    s7_make_signature(s7, 7, p, p, i, i, t, t, s));
6287 
6288   Xen_define_typed_dilambda(S_filter_control_envelope, g_filter_control_envelope_w, H_filter_control_envelope,
6289 			    S_set S_filter_control_envelope, g_set_filter_control_envelope_w, 0, 1, 1, 1,
6290 			    s7_make_signature(s7, 2, p, t), s7_make_signature(s7, 3, p, t, p));
6291   Xen_define_typed_dilambda(S_sound_properties, g_sound_properties_w, H_sound_properties,
6292 			    S_set S_sound_properties, g_set_sound_properties_w, 0, 1, 1, 1,
6293 			    s7_make_circular_signature(s7, 0, 1, t), s7_make_circular_signature(s7, 0, 1, t));
6294   Xen_define_typed_dilambda(S_sound_property, g_sound_property_w, H_sound_property,
6295 			    S_set S_sound_property, g_set_sound_property_w, 1, 1, 2, 1,
6296 			    s7_make_circular_signature(s7, 0, 1, t), s7_make_circular_signature(s7, 0, 1, t));
6297 
6298   Xen_define_typed_dilambda(S_show_controls, g_show_controls_w, H_show_controls,
6299 			    S_set S_show_controls, g_set_show_controls_w, 0, 1, 1, 1, pl_bo, pl_bob);
6300   Xen_define_typed_dilambda(S_sync, g_sync_w, H_sync,
6301 			    S_set S_sync, g_set_sync_w, 0, 1, 1, 1, pl_io, pl_ioz);
6302   Xen_define_typed_dilambda(S_channel_style, g_channel_style_w, H_channel_style,
6303 			    S_set S_channel_style, g_set_channel_style_w, 0, 1, 1, 1, pl_io, pl_ioi);
6304   Xen_define_typed_dilambda(S_read_only, g_read_only_w, H_read_only,
6305 			    S_set S_read_only, g_set_read_only_w, 0, 1, 1, 1, pl_bo, pl_bob);
6306   Xen_define_typed_dilambda(S_expand_control_on, g_expand_control_on_w, H_expand_control_on,
6307 			    S_set S_expand_control_on, g_set_expand_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
6308   Xen_define_typed_dilambda(S_contrast_control_on, g_contrast_control_on_w, H_contrast_control_on,
6309 			    S_set S_contrast_control_on, g_set_contrast_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
6310   Xen_define_typed_dilambda(S_reverb_control_on, g_reverb_control_on_w, H_reverb_control_on,
6311 			    S_set S_reverb_control_on, g_set_reverb_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
6312   Xen_define_typed_dilambda(S_filter_control_on, g_filter_control_on_w, H_filter_control_on,
6313 			    S_set S_filter_control_on, g_set_filter_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
6314   Xen_define_typed_dilambda(S_filter_control_in_dB, g_filter_control_in_dB_w, H_filter_control_in_dB,
6315 			    S_set S_filter_control_in_dB, g_set_filter_control_in_dB_w, 0, 1, 1, 1, pl_bo, pl_bob);
6316   Xen_define_typed_dilambda(S_filter_control_in_hz, g_filter_control_in_hz_w, H_filter_control_in_hz,
6317 			    S_set S_filter_control_in_hz, g_set_filter_control_in_hz_w, 0, 1, 1, 1, pl_bo, pl_bob);
6318   Xen_define_typed_dilambda(S_filter_control_order, g_filter_control_order_w, H_filter_control_order,
6319 			    S_set S_filter_control_order, g_set_filter_control_order_w, 0, 1, 1, 1, pl_io, pl_ioi);
6320   Xen_define_typed_dilambda(S_contrast_control, g_contrast_control_w, H_contrast_control,
6321 			    S_set S_contrast_control, g_set_contrast_control_w, 0, 1, 1, 1, pl_ro, pl_ror);
6322   Xen_define_typed_dilambda(S_contrast_control_bounds, g_contrast_control_bounds_w, H_contrast_control_bounds,
6323 			    S_set S_contrast_control_bounds, g_set_contrast_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
6324   Xen_define_typed_dilambda(S_contrast_control_amp, g_contrast_control_amp_w, H_contrast_control_amp,
6325 			    S_set S_contrast_control_amp, g_set_contrast_control_amp_w, 0, 1, 1, 1, pl_ro, pl_ror);
6326   Xen_define_typed_dilambda(S_expand_control, g_expand_control_w, H_expand_control,
6327 			    S_set S_expand_control, g_set_expand_control_w, 0, 1, 1, 1, pl_ro, pl_ror);
6328   Xen_define_typed_dilambda(S_expand_control_bounds, g_expand_control_bounds_w, H_expand_control_bounds,
6329 			    S_set S_expand_control_bounds, g_set_expand_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
6330   Xen_define_typed_dilambda(S_expand_control_length, g_expand_control_length_w, H_expand_control_length,
6331 			    S_set S_expand_control_length, g_set_expand_control_length_w, 0, 1, 1, 1, pl_ro, pl_ror);
6332   Xen_define_typed_dilambda(S_expand_control_ramp, g_expand_control_ramp_w, H_expand_control_ramp,
6333 			    S_set S_expand_control_ramp, g_set_expand_control_ramp_w, 0, 1, 1, 1, pl_ro, pl_ror);
6334   Xen_define_typed_dilambda(S_expand_control_hop, g_expand_control_hop_w, H_expand_control_hop,
6335 			    S_set S_expand_control_hop, g_set_expand_control_hop_w, 0, 1, 1, 1, pl_ro, pl_ror);
6336   Xen_define_typed_dilambda(S_expand_control_jitter, g_expand_control_jitter_w, H_expand_control_jitter,
6337 			    S_set S_expand_control_jitter, g_set_expand_control_jitter_w, 0, 1, 1, 1, pl_ro, pl_ror);
6338   Xen_define_typed_dilambda(S_speed_control, g_speed_control_w, H_speed_control,
6339 			    S_set S_speed_control, g_set_speed_control_w, 0, 1, 1, 1, pl_ro, pl_ror);
6340   Xen_define_typed_dilambda(S_speed_control_bounds, g_speed_control_bounds_w, H_speed_control_bounds,
6341 			    S_set S_speed_control_bounds, g_set_speed_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
6342   Xen_define_typed_dilambda(S_reverb_control_length, g_reverb_control_length_w, H_reverb_control_length,
6343 			    S_set S_reverb_control_length, g_set_reverb_control_length_w, 0, 1, 1, 1, pl_ro, pl_ror);
6344   Xen_define_typed_dilambda(S_reverb_control_length_bounds, g_reverb_control_length_bounds_w, H_reverb_control_length_bounds,
6345 			    S_set S_reverb_control_length_bounds, g_set_reverb_control_length_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
6346   Xen_define_typed_dilambda(S_reverb_control_scale, g_reverb_control_scale_w, H_reverb_control_scale,
6347 			    S_set S_reverb_control_scale, g_set_reverb_control_scale_w, 0, 1, 1, 1, pl_ro, pl_ror);
6348   Xen_define_typed_dilambda(S_reverb_control_scale_bounds, g_reverb_control_scale_bounds_w, H_reverb_control_scale_bounds,
6349 			    S_set S_reverb_control_scale_bounds, g_set_reverb_control_scale_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
6350   Xen_define_typed_dilambda(S_reverb_control_feedback, g_reverb_control_feedback_w, H_reverb_control_feedback,
6351 			    S_set S_reverb_control_feedback, g_set_reverb_control_feedback_w, 0, 1, 1, 1, pl_ro, pl_ror);
6352   Xen_define_typed_dilambda(S_reverb_control_lowpass, g_reverb_control_lowpass_w, H_reverb_control_lowpass,
6353 			    S_set S_reverb_control_lowpass, g_set_reverb_control_lowpass_w, 0, 1, 1, 1, pl_ro, pl_ror);
6354   Xen_define_typed_dilambda(S_amp_control, g_amp_control_w, H_amp_control,
6355 			    S_set S_amp_control, g_set_amp_control_w, 0, 2, 1, 2, pl_roo,pl_roor);
6356   Xen_define_typed_dilambda(S_amp_control_bounds, g_amp_control_bounds_w, H_amp_control_bounds,
6357 			    S_set S_amp_control_bounds, g_set_amp_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
6358   Xen_define_typed_dilambda(S_reverb_control_decay, g_reverb_control_decay_w, H_reverb_control_decay,
6359 			    S_set S_reverb_control_decay, g_set_reverb_control_decay_w, 0, 1, 1, 1, pl_ro, pl_ror);
6360 
6361   #define H_speed_control_as_float "The value for " S_speed_control_style " that interprets the speed slider as a float"
6362   #define H_speed_control_as_ratio "The value for " S_speed_control_style " that interprets the speed slider as a just-intonation ratio"
6363   #define H_speed_control_as_semitone "The value for " S_speed_control_style " that interprets the speed slider as a microtone (via " S_speed_control_tones ")"
6364 
6365   Xen_define_constant(S_speed_control_as_float,        SPEED_CONTROL_AS_FLOAT,    H_speed_control_as_float);
6366   Xen_define_constant(S_speed_control_as_ratio,        SPEED_CONTROL_AS_RATIO,    H_speed_control_as_ratio);
6367   Xen_define_constant(S_speed_control_as_semitone,     SPEED_CONTROL_AS_SEMITONE, H_speed_control_as_semitone);
6368 
6369   Xen_define_typed_dilambda(S_speed_control_style, g_speed_control_style_w, H_speed_control_style,
6370 			    S_set S_speed_control_style, g_set_speed_control_style_w, 0, 1, 1, 1, pl_io, pl_ioi);
6371   Xen_define_typed_dilambda(S_speed_control_tones, g_speed_control_tones_w, H_speed_control_tones,
6372 			    S_set S_speed_control_tones, g_set_speed_control_tones_w, 0, 1, 1, 1, pl_io, pl_ioi);
6373 
6374   Xen_define_typed_procedure(S_channel_amp_envs,        g_channel_amp_envs_w,         0, 5, 0, H_channel_amp_envs, s7_make_signature(s7, 6, t, t, i, i, t, t));
6375 
6376   Xen_define_typed_procedure(S_sounds,                  g_sounds_w,                   0, 0, 0, H_sounds, s7_make_signature(s7, 1, s7_make_symbol(s7, "list?")));
6377   Xen_define_typed_procedure(S_integer_to_sound,        g_integer_to_sound_w,         1, 0, 0, H_integer_to_sound, pl_oi);
6378   Xen_define_typed_procedure(S_sound_to_integer,        g_sound_to_integer_w,         1, 0, 0, H_sound_to_integer, pl_io);
6379 
6380 #if HAVE_SCHEME
6381   s7_set_documentation(s7, ss->channel_style_symbol, "*channel-style*: how multichannel sounds lay out the channels: channels-combined, channels-separate or channels-superimposed.");
6382   s7_set_documentation(s7, ss->filter_control_in_db_symbol, "*filter-control-in-dB*: #t if snd's filter envelope is displayed in dB in control panel");
6383   s7_set_documentation(s7, ss->filter_control_in_hz_symbol, "*filter-control-in-hz*: #t if snd's filter envelope x axis should be in hz (control panel filter)");
6384   s7_set_documentation(s7, ss->speed_control_tones_symbol, "*speed-control-tones*: the speed-control octave divisions (12)");
6385   s7_set_documentation(s7, ss->speed_control_style_symbol, "*speed-control-style*: speed control choice (speed-control-as-float etc)");
6386   s7_set_documentation(s7, ss->expand_control_length_symbol, "*expand-control-length*: current expansion segment length in seconds (.15)");
6387   s7_set_documentation(s7, ss->expand_control_ramp_symbol, "*expand-control-ramp*: current expansion ramp time (.4)");
6388   s7_set_documentation(s7, ss->expand_control_hop_symbol, "*expand-control-hop*: current expansion output grain spacing in seconds (0.05)");
6389   s7_set_documentation(s7, ss->expand_control_jitter_symbol, "*expand-control-jitter*: current expansion output grain spacing jitter (0.1)");
6390   s7_set_documentation(s7, ss->contrast_control_amp_symbol, "*contrast-control-amp*: contrast amp");
6391   s7_set_documentation(s7, ss->reverb_control_feedback_symbol, "*reverb-control-feedback*: control-panel reverb feedback scaler");
6392   s7_set_documentation(s7, ss->reverb_control_lowpass_symbol, "*reverb-control-lowpass*: control-panel reverb lowpass filter coefficient");
6393   s7_set_documentation(s7, ss->reverb_control_decay_symbol, "*reverb-control-decay*: control-panel reverb decay time (1.0 seconds)");
6394   s7_set_documentation(s7, ss->filter_control_order_symbol, "*filter-control-order*: control-panel filter order");
6395   s7_set_documentation(s7, ss->show_controls_symbol, "*show-controls*: #t if snd's control panel is known to be open");
6396 
6397   s7_set_setter(s7, ss->channel_style_symbol, s7_make_function(s7, "[acc-" S_channel_style "]", acc_channel_style, 2, 0, false, "accessor"));
6398   s7_set_setter(s7, ss->filter_control_in_db_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_dB "]", acc_filter_control_in_dB, 2, 0, false, "accessor"));
6399   s7_set_setter(s7, ss->filter_control_in_hz_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_hz "]", acc_filter_control_in_hz, 2, 0, false, "accessor"));
6400   s7_set_setter(s7, ss->speed_control_tones_symbol, s7_make_function(s7, "[acc-" S_speed_control_tones "]", acc_speed_control_tones, 2, 0, false, "accessor"));
6401   s7_set_setter(s7, ss->speed_control_style_symbol, s7_make_function(s7, "[acc-" S_speed_control_style "]", acc_speed_control_style, 2, 0, false, "accessor"));
6402   s7_set_setter(s7, ss->expand_control_length_symbol, s7_make_function(s7, "[acc-" S_expand_control_length "]", acc_expand_control_length, 2, 0, false, "accessor"));
6403   s7_set_setter(s7, ss->expand_control_ramp_symbol, s7_make_function(s7, "[acc-" S_expand_control_ramp "]", acc_expand_control_ramp, 2, 0, false, "accessor"));
6404   s7_set_setter(s7, ss->expand_control_hop_symbol, s7_make_function(s7, "[acc-" S_expand_control_hop "]", acc_expand_control_hop, 2, 0, false, "accessor"));
6405   s7_set_setter(s7, ss->expand_control_jitter_symbol, s7_make_function(s7, "[acc-" S_expand_control_jitter "]", acc_expand_control_jitter, 2, 0, false, "accessor"));
6406   s7_set_setter(s7, ss->contrast_control_amp_symbol, s7_make_function(s7, "[acc-" S_contrast_control_amp "]", acc_contrast_control_amp, 2, 0, false, "accessor"));
6407   s7_set_setter(s7, ss->reverb_control_feedback_symbol, s7_make_function(s7, "[acc-" S_reverb_control_feedback "]", acc_reverb_control_feedback, 2, 0, false, "accessor"));
6408   s7_set_setter(s7, ss->reverb_control_lowpass_symbol, s7_make_function(s7, "[acc-" S_reverb_control_lowpass "]", acc_reverb_control_lowpass, 2, 0, false, "accessor"));
6409   s7_set_setter(s7, ss->reverb_control_decay_symbol, s7_make_function(s7, "[acc-" S_reverb_control_decay "]", acc_reverb_control_decay, 2, 0, false, "accessor"));
6410   s7_set_setter(s7, ss->filter_control_order_symbol, s7_make_function(s7, "[acc-" S_filter_control_order "]", acc_filter_control_order, 2, 0, false, "accessor"));
6411   s7_set_setter(s7, ss->show_controls_symbol, s7_make_function(s7, "[acc-" S_show_controls "]", acc_show_controls, 2, 0, false, "accessor"));
6412 #endif
6413 }
6414