1/*
2 * Copyright (C) 1997-2005 Kare Sjolander <kare@speech.kth.se>
3 *
4 * This file is part of the Snack Sound Toolkit.
5 * The latest version can be found at http://www.speech.kth.se/snack/
6 *
7 * This program is free software; you can redistribute it and/or modify
8 * it under the terms of the GNU General Public License as published by
9 * the Free Software Foundation; either version 2 of the License, or
10 * (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20 */
21
22#include <stdlib.h>
23#include <string.h>
24#include <math.h>
25#include "snack.h"
26
27extern int littleEndian;
28
29struct Snack_FileFormat *snackFileFormats = NULL;
30
31extern int useOldObjAPI;
32
33static char *
34GuessWavFile(char *buf, int len)
35{
36  if (len < 21) return(QUE_STRING);
37  if (strncasecmp("RIFF", buf, strlen("RIFF")) == 0) {
38    if (buf[20] == 85) {
39      return(MP3_STRING);
40    }
41    if (strncasecmp("WAVE", &buf[8], strlen("WAVE")) == 0) {
42      return(WAV_STRING);
43    }
44  }
45  return(NULL);
46}
47
48static char *
49GuessAuFile(char *buf, int len)
50{
51  if (len < 4) return(QUE_STRING);
52  if (strncmp(".snd", buf, strlen(".snd")) == 0) {
53    return(AU_STRING);
54  }
55  return(NULL);
56}
57
58static char *
59GuessAiffFile(char *buf, int len)
60{
61  if (len < 12) return(QUE_STRING);
62  if (strncasecmp("FORM", buf, strlen("FORM")) == 0) {
63    if (strncasecmp("AIFF", &buf[8], strlen("AIFF")) == 0) {
64      return(AIFF_STRING);
65    }
66  }
67  return(NULL);
68}
69
70static char *
71GuessSmpFile(char *buf, int len)
72{
73  int i, end = len - strlen("file=samp");
74
75  for (i = 0; i < end; i++) {
76    if (strncasecmp("file=samp", &buf[i], strlen("file=samp")) == 0) {
77      return(SMP_STRING);
78    }
79  }
80  if (len < 512) return(QUE_STRING);
81  return(NULL);
82}
83
84static char *
85GuessSdFile(char *buf, int len)
86{
87  if (len < 20) return(QUE_STRING);
88  if (buf[16] == 0 && buf[17] == 0 && buf[18] == 106 && buf[19] == 26) {
89    return(SD_STRING);
90  }
91  return(NULL);
92}
93
94static char *
95GuessCslFile(char *buf, int len)
96{
97  if (len < 8) return(QUE_STRING);
98  if (strncmp("FORMDS16", buf, strlen("FORMDS16")) == 0) {
99    return(CSL_STRING);
100  }
101  return(NULL);
102}
103
104static char *
105GuessRawFile(char *buf, int len)
106{
107  return(RAW_STRING);
108}
109
110char *
111GuessFileType(char *buf, int len, int eof)
112{
113  Snack_FileFormat *ff;
114  int flag = 0;
115
116  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
117    char *type = (ff->guessProc)(buf, len);
118
119    if (type == NULL) {
120      /* guessProc can't recognize this header */
121    } else if (strcmp(type, QUE_STRING) == 0) {
122      flag = 1; /* guessProc needs more bytes in order to decide */
123    } else if (strcmp(type, RAW_STRING) != 0) {
124      return(type);
125    }
126  }
127
128  /* Don't decide yet if there's more header bytes to be had */
129
130  if (flag && !eof) {
131    return(QUE_STRING);
132  }
133
134  /* No guessProc recognized this header => guess RAW format */
135
136  return(RAW_STRING);
137}
138
139static int
140ExtCmp(char *s1, char *s2)
141{
142  int l1 = strlen(s1);
143  int l2 = strlen(s2);
144
145  return(strncasecmp(s1, &s2[l2 - l1], l1));
146}
147
148static char *
149ExtSmpFile(char *s)
150{
151  if (ExtCmp(".smp", s) == 0) {
152    return(SMP_STRING);
153  }
154  return(NULL);
155}
156
157static char *
158ExtWavFile(char *s)
159{
160  if (ExtCmp(".wav", s) == 0) {
161    return(WAV_STRING);
162  }
163  return(NULL);
164}
165
166static char *
167ExtAuFile(char *s)
168{
169  if (ExtCmp(".au", s) == 0 || ExtCmp(".snd", s) == 0) {
170    return(AU_STRING);
171  }
172  return(NULL);
173}
174
175static char *
176ExtAiffFile(char *s)
177{
178  if (ExtCmp(".aif", s) == 0 || ExtCmp(".aiff", s) == 0) {
179    return(AIFF_STRING);
180  }
181  return(NULL);
182}
183
184static char *
185ExtSdFile(char *s)
186{
187  if (ExtCmp(".sd", s) == 0) {
188    return(SD_STRING);
189  }
190  return(NULL);
191}
192
193static char *
194ExtCslFile(char *s)
195{
196  if (ExtCmp(".nsp", s) == 0) {
197    return(CSL_STRING);
198  }
199  return(NULL);
200}
201
202char *
203NameGuessFileType(char *s)
204{
205  Snack_FileFormat *ff;
206
207  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
208    if (ff->extProc != NULL) {
209      char *type = (ff->extProc)(s);
210      if (type != NULL) {
211	return(type);
212      }
213    }
214  }
215  return(RAW_STRING);
216}
217/*
218static short
219ReadBEShort(Tcl_Channel ch)
220{
221  short ts;
222
223  Tcl_Read(ch, (char *) &ts, sizeof(short));
224
225  if (littleEndian) {
226  ts = Snack_SwapShort(ts);
227  }
228
229  return(ts);
230}
231
232static short
233ReadLEShort(Tcl_Channel ch)
234{
235  short ts;
236
237  Tcl_Read(ch, (char *) &ts, sizeof(short));
238
239  if (!littleEndian) {
240    ts = Snack_SwapShort(ts);
241  }
242
243  return(ts);
244}
245
246static int32_t
247ReadBELong(Tcl_Channel ch)
248{
249  int32_t tl;
250
251  Tcl_Read(ch, (char *) &tl, sizeof(int32_t));
252
253  if (littleEndian) {
254    tl = Snack_SwapLong(tl);
255  }
256
257  return(tl);
258}
259
260static int32_t
261ReadLELong(Tcl_Channel ch)
262{
263  int32_t tl;
264
265  Tcl_Read(ch, (char *) &tl, sizeof(int32_t));
266
267  if (!littleEndian) {
268    tl = Snack_SwapLong(tl);
269  }
270
271  return(tl);
272}
273*/
274static int
275WriteLEShort(Tcl_Channel ch, short s)
276{
277  short ts = s;
278
279  if (!littleEndian) {
280    ts = Snack_SwapShort(ts);
281  }
282
283  return(Tcl_Write(ch, (char *) &ts, sizeof(short)));
284}
285
286int
287WriteLELong(Tcl_Channel ch, int32_t l)
288{
289  int32_t tl = l;
290
291  if (!littleEndian) {
292    tl = Snack_SwapLong(tl);
293  }
294
295  return(Tcl_Write(ch, (char *) &tl, sizeof(int32_t)));
296}
297
298static int
299WriteBEShort(Tcl_Channel ch, short s)
300{
301  short ts = s;
302
303  if (littleEndian) {
304    ts = Snack_SwapShort(ts);
305  }
306
307  return(Tcl_Write(ch, (char *) &ts, sizeof(short)));
308}
309
310int
311WriteBELong(Tcl_Channel ch, int32_t l)
312{
313  int32_t tl = l;
314
315  if (littleEndian) {
316    tl = Snack_SwapLong(tl);
317  }
318
319  return(Tcl_Write(ch, (char *) &tl, sizeof(int32_t)));
320}
321
322static int32_t
323GetLELong(char *buf, int pos)
324{
325  int32_t tl;
326
327  memcpy(&tl, &buf[pos], sizeof(int32_t));
328
329  if (!littleEndian) {
330    tl = Snack_SwapLong(tl);
331  }
332
333  return(tl);
334}
335
336static short
337GetLEShort(char *buf, int pos)
338{
339  short ts;
340  char *p;
341  short *q;
342
343  p = &buf[pos];
344  q = (short *) p;
345  ts = *q;
346
347  if (!littleEndian) {
348    ts = Snack_SwapShort(ts);
349  }
350
351  return(ts);
352}
353
354static int32_t
355GetBELong(char *buf, int pos)
356{
357  int32_t tl;
358
359  memcpy(&tl, &buf[pos], sizeof(int32_t));
360
361  if (littleEndian) {
362    tl = Snack_SwapLong(tl);
363  }
364
365  return(tl);
366}
367
368static short
369GetBEShort(char *buf, int pos)
370{
371  short ts;
372  char *p;
373  short *q;
374
375  p = &buf[pos];
376  q = (short *) p;
377  ts = *q;
378
379  if (littleEndian) {
380    ts = Snack_SwapShort(ts);
381  }
382
383  return(ts);
384}
385
386static void
387PutBELong(char *buf, int pos, int32_t l)
388{
389  int32_t tl = l;
390
391  if (littleEndian) {
392    tl = Snack_SwapLong(tl);
393  }
394
395  memcpy(&buf[pos], &tl, sizeof(int32_t));
396}
397
398static void
399PutBEShort(char *buf, int pos, short s)
400{
401  short ts = s;
402  char *p;
403  short *q;
404
405  p = &buf[pos];
406  q = (short *) p;
407
408  if (littleEndian) {
409    ts = Snack_SwapShort(ts);
410  }
411
412  *q = ts;
413}
414
415/* Note: pos must be a multiple of 4 */
416
417static void
418PutLELong(char *buf, int pos, int32_t l)
419{
420  int32_t tl = l;
421  char *p;
422  int32_t *q;
423
424  p = &buf[pos];
425  q = (int32_t *) p;
426
427  if (!littleEndian) {
428    tl = Snack_SwapLong(tl);
429  }
430
431  *q = tl;
432}
433
434static void
435PutLEShort(char *buf, int pos, short s)
436{
437  short ts = s;
438  char *p;
439  short *q;
440
441  p = &buf[pos];
442  q = (short *) p;
443
444  if (!littleEndian) {
445    ts = Snack_SwapShort(ts);
446  }
447
448  *q = ts;
449}
450
451extern short shortBuffer[];
452extern float floatBuffer[];
453
454static int
455ReadSound(readSamplesProc *readProc, Sound *s, Tcl_Interp *interp,
456	  Tcl_Channel ch, Tcl_Obj *obj, int startpos, int endpos)
457{
458  int tot, totrlen = 0, res, i, j = s->loadOffset, size;
459  char *b = (char *) shortBuffer;
460
461  if (s->debug > 1) Snack_WriteLogInt("  Enter ReadSound", s->length);
462
463  if (s->length > 0) {
464    if (endpos < 0 || endpos > (s->length - 1)) {
465      endpos = s->length - 1;
466    }
467    s->length = endpos - startpos + 1;
468    if (s->length < 0) s->length = 0;
469    if (Snack_ResizeSoundStorage(s, s->length) != TCL_OK) {
470      s->length = 0;
471      Tcl_AppendResult(interp, "Memory allocation failed", NULL);
472      return TCL_ERROR;
473    }
474  }
475  if (s->encoding == SNACK_DOUBLE) {
476    s->sampsize = 8;
477  }
478  if (s->length == -1) {
479    tot = 1 << 30;
480  } else {
481    tot = (s->length - s->loadOffset) * s->sampsize * s->nchannels;
482  }
483  Snack_ProgressCallback(s->cmdPtr, interp, "Reading sound", 0.0);
484
485  while (tot > 0) {
486    int rlen;
487
488    if (s->encoding != LIN24) {
489      size = min(tot, sizeof(short) * PBSIZE);
490    } else {
491      size = min(tot, sizeof(short) * (PBSIZE - 1));
492    }
493    /* Samples on disk are 8 bytes -> make sure they fit in buffer */
494    if (s->encoding == SNACK_DOUBLE && size > (PBSIZE / 2)) {
495      size /= 2;
496    }
497    if (s->length == -1) {
498      if (Snack_ResizeSoundStorage(s, s->maxlength+1) != TCL_OK) {
499	s->length = 0;
500	Tcl_AppendResult(interp, "Memory allocation failed", NULL);
501	return TCL_ERROR;
502      }
503    }
504    if (ch != NULL) {
505      if (readProc == NULL) {
506	rlen = Tcl_Read(ch, b, size);
507	tot -= size;
508      } else {
509	size = min(s->length * s->nchannels, PBSIZE);
510	rlen = (readProc)(s, interp, ch, NULL, (float*)&floatBuffer, size);
511	Snack_PutSoundData(s, totrlen / s->sampsize, &floatBuffer, rlen);
512	if (rlen > 0) {
513	  rlen *= s->sampsize;
514	  tot -= rlen;
515	}
516      }
517      if (rlen < 0) {
518	Tcl_AppendResult(interp, "Error reading data", NULL);
519	return TCL_ERROR;
520      }
521      totrlen += rlen;
522      if (rlen < size) {
523	tot = 0;
524      }
525    } else {
526      int length = 0;
527      unsigned char *ptr = NULL;
528      if (useOldObjAPI) {
529	ptr = (unsigned char *) obj->bytes;
530      } else {
531#ifdef TCL_81_API
532	Tcl_GetByteArrayFromObj(obj, &length);
533	ptr = Tcl_GetByteArrayFromObj(obj, NULL);
534#endif
535      }
536      if (readProc == NULL) {
537	memcpy(b, &ptr[totrlen + s->headSize + startpos * s->sampsize
538		      * s->nchannels], size);
539	totrlen += size;
540	tot -= size;
541      } else {
542	size = min(tot / (s->sampsize * s->nchannels), PBSIZE);
543	/*printf("%d cnk %d obj %d slen %d\n", tot, size, length, s->length);*/
544	rlen = (readProc)(s, interp, NULL, (char *) ptr, (float*)&floatBuffer,
545			  size);
546	Snack_PutSoundData(s, totrlen / s->sampsize, &floatBuffer, rlen);
547	rlen *= s->sampsize;
548	totrlen += rlen;
549	tot -= rlen;
550	if (rlen < size) {
551	  tot = 0;
552	}
553      }
554    }
555
556    if (readProc == NULL) { /* unpack block */
557      unsigned char *q = (unsigned char *) b;
558      char   *sc = (char *)   b;
559      short  *r  = (short *)  b;
560      int    *is = (int *)    b;
561      float  *fs = (float *)  b;
562      double *fd = (double *) b;
563
564      if (s->precision == SNACK_SINGLE_PREC) {
565	for (i = 0; i < size / s->sampsize; i++, j++) {
566          int writeblock = (j >> FEXP);
567          if (writeblock >= s->nblks) {
568	    /* Reached end of allocated blocks for s */
569	    break;
570          }
571	  switch (s->encoding) {
572	  case LIN16:
573	    if (s->swap) *r = Snack_SwapShort(*r);
574	    FSAMPLE(s, j) = (float) *r++;
575	    break;
576	  case LIN32:
577	    if (s->swap) *is = Snack_SwapLong(*is);
578	    FSAMPLE(s, j) = (float) *is++;
579	    break;
580	  case SNACK_FLOAT:
581	    if (s->swap) *fs = (float) Snack_SwapFloat(*fs);
582	    FSAMPLE(s, j) = (float) *fs++;
583	    break;
584	  case SNACK_DOUBLE:
585	    if (s->swap) *fd = (float) Snack_SwapDouble(*fd);
586	    FSAMPLE(s, j) = (float) *fd++;
587	    break;
588	  case ALAW:
589	    FSAMPLE(s, j) = (float) Snack_Alaw2Lin(*q++);
590	    break;
591	  case MULAW:
592	    FSAMPLE(s, j) = (float) Snack_Mulaw2Lin(*q++);
593	    break;
594	  case LIN8:
595	    FSAMPLE(s, j) = (float) *sc++;
596	    break;
597	  case LIN8OFFSET:
598	    FSAMPLE(s, j) = (float) *q++;
599	    break;
600	  case LIN24:
601	  case LIN24PACKED:
602	    {
603	      int ee;
604	      if (s->swap) {
605		if (littleEndian) {
606		  ee = 0;
607		} else {
608		  ee = 1;
609		}
610	      } else {
611		if (littleEndian) {
612		  ee = 1;
613		} else {
614		  ee = 0;
615		}
616	      }
617	      if (ee) {
618		int t = *q++;
619		t |= *q++ << 8;
620		t |= *q++ << 16;
621		if (t & 0x00800000) {
622		  t |= (unsigned int) 0xff000000;
623		}
624	        FSAMPLE(s, j) = (float) t;
625	      } else {
626		int t = *q++ << 16;
627		t |= *q++ << 8;
628		t |= *q++;
629		if (t & 0x00800000) {
630		  t |= (unsigned int) 0xff000000;
631		}
632		FSAMPLE(s, j) = (float) t;
633	      }
634	      break;
635	    }
636	  }
637	}
638      } else {   /*s->precision == SNACK_DOUBLE_PREC */
639	for (i = 0; i < size / s->sampsize; i++, j++) {
640          int writeblock = (j >> DEXP);
641          if (writeblock >= s->nblks) {
642	    /* Reached end of allocated blocks for s */
643	    break;
644          }
645	  switch (s->encoding) {
646	  case LIN16:
647	    DSAMPLE(s, j) = (float) *r++;
648	    break;
649	  case LIN32:
650	    DSAMPLE(s, j) = (float) *is++;
651	    break;
652	  case SNACK_FLOAT:
653	    DSAMPLE(s, j) = (float) *fs++;
654	    break;
655	  case ALAW:
656	    DSAMPLE(s, j) = (float) Snack_Alaw2Lin(*q++);
657	    break;
658	  case MULAW:
659	    DSAMPLE(s, j) = (float) Snack_Mulaw2Lin(*q++);
660	    break;
661	  case LIN8:
662	    DSAMPLE(s, j) = (float) *sc++;
663	    break;
664	  case LIN8OFFSET:
665	    DSAMPLE(s, j) = (float) *q++;
666	    break;
667	  case LIN24:
668	  case LIN24PACKED:
669	    {
670	      if (littleEndian) {
671		int t = *q++;
672		t |= *q++ << 8;
673		t |= *q++ << 16;
674		if (t & 0x00800000) {
675		  t |= (unsigned int) 0xff000000;
676		}
677		DSAMPLE(s, j) = (float) t;
678	      } else {
679		int t = *q++ << 16;
680		t |= *q++ << 8;
681		t |= *q++;
682		if (t & 0x00800000) {
683		  t |= (unsigned int) 0xff000000;
684		}
685		DSAMPLE(s, j) = (float) t;
686	      }
687	      break;
688	    }
689	  }
690	}
691      }  /*s->precision == SNACK_DOUBLE_PREC */
692    } /* unpack block */
693
694    res = Snack_ProgressCallback(s->cmdPtr, interp, "Reading sound",
695				 (double) totrlen /
696				 (s->length * s->sampsize * s->nchannels));
697    if (res != TCL_OK) {
698      Snack_ResizeSoundStorage(s, 0);
699      s->length = 0;
700      return TCL_ERROR;
701    }
702  }
703
704  if ((double) totrlen / (s->length * s->sampsize * s->nchannels) != 1.0) {
705    Snack_ProgressCallback(s->cmdPtr, interp, "Reading sound", 1.0);
706  }
707  if (s->length * s->sampsize * s->nchannels != totrlen) {
708    s->length = totrlen / (s->sampsize * s->nchannels);
709  }
710  if (s->length == -1) {
711    s->length = totrlen / (s->sampsize * s->nchannels);
712  }
713
714  if (s->loadOffset > 0) {
715    if (s->precision == SNACK_SINGLE_PREC) {
716      for (i = 0; i < s->loadOffset; i++) {
717	FSAMPLE(s, i) = 0.0f;
718      }
719    } else {
720      for (i = 0; i < s->loadOffset; i++) {
721	DSAMPLE(s, i) = 0.0;
722      }
723    }
724    s->length += s->loadOffset;
725    s->loadOffset = 0;
726  }
727  if (s->encoding == SNACK_DOUBLE) {
728    s->sampsize = 4;
729  }
730
731  if (s->debug > 1) Snack_WriteLogInt("  Exit ReadSound", s->length);
732
733  return TCL_OK;
734}
735
736int
737WriteSound(writeSamplesProc *writeProc, Sound *s, Tcl_Interp *interp,
738	   Tcl_Channel ch, Tcl_Obj *obj, int startpos, int len)
739{
740  int i = 0, j;
741  short sh;
742  int   is;
743  float fs;
744  unsigned char uc;
745  char c;
746
747  if (s->debug > 1) Snack_WriteLog("  Enter WriteSound\n");
748
749  if (s->inByteOrder == SNACK_NATIVE && s->swap) {
750    if (littleEndian) {
751      s->inByteOrder = SNACK_BIGENDIAN;
752    } else {
753      s->inByteOrder = SNACK_LITTLEENDIAN;
754    }
755  }
756
757  startpos *= s->nchannels;
758  len      *= s->nchannels;
759
760  if (ch != NULL) {
761    Snack_ProgressCallback(s->cmdPtr, interp, "Writing sound", 0.0);
762    if (writeProc == NULL) {
763      for (i = startpos; i < startpos + len; i++) {
764
765	if (s->storeType == SOUND_IN_MEMORY || s->readStatus == READ) {
766	  fs = FSAMPLE(s, i);
767	} else {
768	  fs = GetSample(&s->linkInfo, i);
769	}
770
771	/* pack sample */
772
773	switch (s->encoding) {
774	case LIN16:
775	  if (fs > 32767.0f)  fs = 32767.0f;
776	  if (fs < -32768.0f) fs = -32768.0f;
777	  sh = (short) fs;
778	  switch (s->inByteOrder) {
779	  case SNACK_NATIVE:
780	    if (Tcl_Write(ch, (char *) &sh, 2) == -1) return TCL_ERROR;
781	    break;
782	  case SNACK_BIGENDIAN:
783	    if (WriteBEShort(ch, sh) == -1) return TCL_ERROR;
784	    break;
785	  case SNACK_LITTLEENDIAN:
786	    if (WriteLEShort(ch, sh) == -1) return TCL_ERROR;
787	    break;
788	  }
789	  break;
790	case LIN32:
791	  if (fs > 2147483647.0f)  fs = 2147483647.0f;
792	  if (fs < -2147483648.0f) fs = -2147483648.0f;
793	  is = (int) fs;
794	  switch (s->inByteOrder) {
795	  case SNACK_NATIVE:
796	    break;
797	  case SNACK_BIGENDIAN:
798	    if (littleEndian) {
799	      is = Snack_SwapLong(is);
800	    }
801	    break;
802	  case SNACK_LITTLEENDIAN:
803	    if (!littleEndian) {
804	      is = Snack_SwapLong(is);
805	    }
806	    break;
807	  }
808	  if (Tcl_Write(ch, (char *) &is, 4) == -1) return TCL_ERROR;
809	  break;
810	case SNACK_FLOAT:
811	  if (fs > 32767.0f)  fs = 32767.0f;
812	  if (fs < -32768.0f) fs = -32768.0f;
813	  switch (s->inByteOrder) {
814	  case SNACK_NATIVE:
815	    break;
816	  case SNACK_BIGENDIAN:
817	    if (littleEndian) {
818	      fs = Snack_SwapFloat(fs);
819	    }
820	    break;
821	  case SNACK_LITTLEENDIAN:
822	    if (!littleEndian) {
823	      fs = Snack_SwapFloat(fs);
824	    }
825	    break;
826	  }
827	  if (Tcl_Write(ch, (char *) &fs, 4) == -1) return TCL_ERROR;
828	  break;
829	case ALAW:
830	  {
831	    if (fs > 32767.0f)  fs = 32767.0f;
832	    if (fs < -32768.0f) fs = -32768.0f;
833	    uc = Snack_Lin2Alaw((short) fs);
834	    if (Tcl_Write(ch, (char *)&uc, 1) == -1) return TCL_ERROR;
835	    break;
836	  }
837	case MULAW:
838	  {
839	    if (fs > 32767.0f)  fs = 32767.0f;
840	    if (fs < -32768.0f) fs = -32768.0f;
841	    uc = Snack_Lin2Mulaw((short) fs);
842	    if (Tcl_Write(ch, (char *)&uc, 1) == -1) return TCL_ERROR;
843	    break;
844	  }
845	case LIN8:
846	  {
847	    if (fs > 127.0f)  fs = 127.0f;
848	    if (fs < -128.0f) fs = -128.0f;
849	    c = (char) fs;
850	    if (Tcl_Write(ch, (char *)&c, 1) == -1) return TCL_ERROR;
851	    break;
852	  }
853	case LIN8OFFSET:
854	  {
855	    if (fs > 255.0f) fs = 255.0f;
856	    if (fs < 0.0f)  fs = 0.0f;
857	    uc = (unsigned char) fs;
858	    if (Tcl_Write(ch, (char *)&uc, 1) == -1) return TCL_ERROR;
859	    break;
860	  }
861	case LIN24:
862	case LIN24PACKED:
863	  {
864	    int offset = 0;
865	    union {
866	      char c[sizeof(int)];
867	      int i;
868	    } pack;
869
870	    if (fs > 8388607.0f)  fs = 8388607.0f;
871	    if (fs < -8388608.0f) fs = -8388608.0f;
872	    is = (int) fs;
873	    switch (s->inByteOrder) {
874	    case SNACK_NATIVE:
875	      break;
876	    case SNACK_BIGENDIAN:
877	    if (littleEndian) {
878	      is = Snack_SwapLong(is);
879	    }
880	    break;
881	    case SNACK_LITTLEENDIAN:
882	      if (!littleEndian) {
883		is = Snack_SwapLong(is);
884	      }
885	      break;
886	    }
887
888	    if (littleEndian) {
889	      offset = 1;
890	    } else {
891	      offset = 1;
892	    }
893	    pack.i = (int) is;
894	    if (Tcl_Write(ch, (char *) &pack.c[offset], 3) == -1) {
895	      return TCL_ERROR;
896	    }
897	  }
898	}
899	if ((i % 100000) == 99999) {
900	  int res = Snack_ProgressCallback(s->cmdPtr, interp, "Writing sound",
901					   (double)(i-startpos)/len);
902	  if (res != TCL_OK) {
903	    return TCL_ERROR;
904	  }
905	}
906      }
907    } else { /* writeProc != NULL */
908      int tot = len;
909
910      while (tot > 0) {
911	int size = min(tot, FBLKSIZE/2), res;
912
913	(writeProc)(s, ch, obj, startpos, size);
914
915	tot -= size;
916	startpos += size;
917	res = Snack_ProgressCallback(s->cmdPtr, interp, "Writing sound",
918				     1.0-(double)tot/len);
919	if (res != TCL_OK) {
920	  return TCL_ERROR;
921	}
922      }
923    }
924    Snack_ProgressCallback(s->cmdPtr, interp, "Writing sound", 1.0);
925  } else { /* ch == NULL */
926    unsigned char *p = NULL;
927
928    if (useOldObjAPI) {
929      Tcl_SetObjLength(obj, s->headSize + len * s->sampsize);
930      p = (unsigned char *) &obj->bytes[s->headSize];
931    } else {
932#ifdef TCL_81_API
933      p = Tcl_SetByteArrayLength(obj, s->headSize +len * s->sampsize);
934      p = &p[s->headSize];
935#endif
936    }
937    for (i = startpos, j = 0; i < startpos + len; i++, j++) {
938      short *sp = (short *) p;
939      int   *ip = (int *) p;
940      float *fp = (float *) p;
941      char  *cp = (char *) p;
942
943      if (s->storeType == SOUND_IN_MEMORY) {
944	fs = FSAMPLE(s, i);
945      } else {
946	fs = GetSample(&s->linkInfo, i);
947      }
948
949      /* pack sample */
950
951      switch (s->encoding) {
952      case LIN16:
953	if (fs > 32767.0f)  fs = 32767.0f;
954	if (fs < -32768.0f) fs = -32768.0f;
955	sh = (short) fs;
956	switch (s->inByteOrder) {
957	case SNACK_NATIVE:
958	  break;
959	case SNACK_BIGENDIAN:
960	  if (littleEndian) {
961	    sh = Snack_SwapShort(sh);
962	  }
963	  break;
964	case SNACK_LITTLEENDIAN:
965	  if (!littleEndian) {
966	    sh = Snack_SwapShort(sh);
967	  }
968	  break;
969	}
970	sp[j] = sh;
971	break;
972      case LIN32:
973	if (fs > 2147483647.0f)  fs = 2147483647.0f;
974	if (fs < -2147483648.0f) fs = -2147483648.0f;
975	is = (int) fs;
976	switch (s->inByteOrder) {
977	case SNACK_NATIVE:
978	  break;
979	case SNACK_BIGENDIAN:
980	  if (littleEndian) {
981	    is = Snack_SwapLong(is);
982	  }
983	  break;
984	case SNACK_LITTLEENDIAN:
985	  if (!littleEndian) {
986	    is = Snack_SwapLong(is);
987	  }
988	  break;
989	}
990	ip[j] = is;
991	break;
992      case SNACK_FLOAT:
993	if (fs > 32767.0f)  fs = 32767.0f;
994	if (fs < -32768.0f) fs = -32768.0f;
995	switch (s->inByteOrder) {
996	case SNACK_NATIVE:
997	  break;
998	case SNACK_BIGENDIAN:
999	  if (littleEndian) {
1000	    fs = Snack_SwapFloat(fs);
1001	  }
1002	  break;
1003	case SNACK_LITTLEENDIAN:
1004	  if (!littleEndian) {
1005	    fs = Snack_SwapFloat(fs);
1006	  }
1007	  break;
1008	}
1009	fp[j] = fs;
1010	break;
1011      case ALAW:
1012	{
1013	  if (fs > 32767.0f)  fs = 32767.0f;
1014	  if (fs < -32768.0f) fs = -32768.0f;
1015	  p[j] = Snack_Lin2Alaw((short) fs);
1016	  break;
1017	}
1018      case MULAW:
1019	{
1020	  if (fs > 32767.0f)  fs = 32767.0f;
1021	  if (fs < -32768.0f) fs = -32768.0f;
1022	  p[j] = Snack_Lin2Mulaw((short) fs);
1023	  break;
1024	}
1025      case LIN8:
1026	{
1027	  if (fs > 127.0f)  fs = 127.0f;
1028	  if (fs < -128.0f) fs = -128.0f;
1029	  cp[j] = (char) fs;
1030	  break;
1031	}
1032      case LIN8OFFSET:
1033	{
1034	  if (fs > 255.0f) fs = 255.0f;
1035	  if (fs < 0.0f)  fs = 0.0f;
1036	  p[j] = (unsigned char) fs;
1037	  break;
1038	}
1039      case LIN24:
1040      case LIN24PACKED:
1041	{
1042	  int offset = 0;
1043	  union {
1044	    char c[sizeof(int)];
1045	    int i;
1046	  } pack;
1047
1048	  if (fs > 8388607.0f) fs = 8388607.0f;
1049	  if (fs < -8388608.0f) fs = -8388608.0f;
1050	  is = (int) fs;
1051
1052	  switch (s->inByteOrder) {
1053	  case SNACK_NATIVE:
1054	    break;
1055	  case SNACK_BIGENDIAN:
1056	    if (littleEndian) {
1057	      is = Snack_SwapLong(is);
1058	    }
1059	    break;
1060	  case SNACK_LITTLEENDIAN:
1061	    if (!littleEndian) {
1062	      is = Snack_SwapLong(is);
1063	    }
1064	    break;
1065	  }
1066
1067	  if (littleEndian) {
1068	    offset = 0;
1069	  } else {
1070	    offset = 1;
1071	  }
1072	  pack.i = (int) is;
1073	  memcpy(&p, &pack.c[offset],3);
1074	  p += 3;
1075	}
1076      }
1077    }
1078  }
1079  if (s->debug > 1) Snack_WriteLog("  Exit WriteSound\n");
1080
1081  return TCL_OK;
1082}
1083#define NFIRSTSAMPLES 40000
1084#define DEFAULT_MULAW_RATE 8000
1085#define DEFAULT_ALAW_RATE 8000
1086#define DEFAULT_LIN8OFFSET_RATE 11025
1087#define DEFAULT_LIN8_RATE 11025
1088
1089typedef enum {
1090  GUESS_LIN16,
1091  GUESS_LIN16S,
1092  GUESS_ALAW,
1093  GUESS_MULAW,
1094  GUESS_LIN8OFFSET,
1095  GUESS_LIN8,
1096  GUESS_LIN24,
1097  GUESS_LIN24S
1098} sampleEncoding;
1099
1100#define GUESS_FFT_LENGTH 512
1101#define SNACK_DEFAULT_GFWINTYPE SNACK_WIN_HAMMING
1102
1103int
1104GuessEncoding(Sound *s, unsigned char *buf, int len) {
1105  int i, j, format;
1106  float energyLIN16 = 0.0, energyLIN16S = 0.0;
1107  float energyMULAW = 0.0, energyALAW = 0.0;
1108  float energyLIN8  = 0.0, energyLIN8O = 0.0, minEnergy;
1109  float energyLIN24 = 0.0, energyLIN24S = 0.0;
1110  float fft[GUESS_FFT_LENGTH];
1111  float totfft[GUESS_FFT_LENGTH];
1112  float hamwin[GUESS_FFT_LENGTH];
1113  double toterg = 0.0, cmperg = 0.0, minBin = 0.0;
1114
1115  if (s->debug > 2) Snack_WriteLogInt("    Enter GuessEncoding", len);
1116
1117  /*
1118    Byte order and sample encoding detection suggested by David van Leeuwen
1119    */
1120
1121  for (i = 0; i < len / 2; i++) {
1122    short sampleLIN16  = ((short *)buf)[i];
1123    short sampleLIN16S = Snack_SwapShort(sampleLIN16);
1124    short sampleMULAW  = Snack_Mulaw2Lin(buf[i]);
1125    short sampleALAW   = Snack_Alaw2Lin(buf[i]);
1126    short sampleLIN8O  = (char)(buf[i] ^ 128) << 8;
1127    short sampleLIN8   = (char)buf[i] << 8;
1128
1129    energyLIN16  += (float) sampleLIN16  * (float) sampleLIN16;
1130    energyLIN16S += (float) sampleLIN16S * (float) sampleLIN16S;
1131    energyMULAW  += (float) sampleMULAW  * (float) sampleMULAW;
1132    energyALAW   += (float) sampleALAW   * (float) sampleALAW;
1133    energyLIN8O  += (float) sampleLIN8O  * (float) sampleLIN8O;
1134    energyLIN8   += (float) sampleLIN8   * (float) sampleLIN8;
1135  }
1136
1137  for (i = 0; i < len / 2; i+=3) {
1138    union {
1139      char c[sizeof(int)];
1140      int s;
1141    } sampleLIN24, sampleLIN24S;
1142
1143    sampleLIN24.c[0] = (char)buf[i];
1144    sampleLIN24.c[1] = (char)buf[i+1];
1145    sampleLIN24.c[2] = (char)buf[i+2];
1146    sampleLIN24S.c[2] = (char)buf[i];
1147    sampleLIN24S.c[1] = (char)buf[i+1];
1148    sampleLIN24S.c[0] = (char)buf[i+2];
1149
1150    sampleLIN24.s /= 65536;
1151    sampleLIN24S.s /= 65536;
1152    energyLIN24  += (float) sampleLIN24.s * (float) sampleLIN24.s;
1153    energyLIN24S += (float) sampleLIN24S.s * (float) sampleLIN24S.s;
1154  }
1155
1156  format = GUESS_LIN16;
1157  minEnergy = energyLIN16;
1158
1159  if (energyLIN16S < minEnergy) {
1160    format = GUESS_LIN16S;
1161    minEnergy = energyLIN16S;
1162  }
1163  if (energyALAW < minEnergy) {
1164    format = GUESS_ALAW;
1165    minEnergy = energyALAW;
1166  }
1167  if (energyMULAW < minEnergy) {
1168    format = GUESS_MULAW;
1169    minEnergy = energyMULAW;
1170  }
1171  if (energyLIN8O < minEnergy) {
1172    format = GUESS_LIN8OFFSET;
1173    minEnergy = energyLIN8O;
1174  }
1175  if (energyLIN8 < minEnergy) {
1176    format = GUESS_LIN8;
1177    minEnergy = energyLIN8;
1178  }
1179  /*if (energyLIN24 < minEnergy) {
1180    format = GUESS_LIN24;
1181    minEnergy = energyLIN24;
1182  }
1183  if (energyLIN24S < minEnergy) {
1184    format = GUESS_LIN24S;
1185    minEnergy = energyLIN24S;
1186  }
1187  printf("AA %f %f %f %f\n", energyLIN16, energyLIN16S, energyLIN24, energyLIN24S);*/
1188  switch (format) {
1189  case GUESS_LIN16:
1190    s->swap = 0;
1191    if (s->sampsize == 1) {
1192      s->length /= 2;
1193    }
1194    s->encoding = LIN16;
1195    s->sampsize = 2;
1196    break;
1197  case GUESS_LIN16S:
1198    s->swap = 1;
1199    if (s->sampsize == 1) {
1200      s->length /= 2;
1201    }
1202    s->encoding = LIN16;
1203    s->sampsize = 2;
1204    break;
1205  case GUESS_ALAW:
1206    if (s->sampsize == 2) {
1207      s->length *= 2;
1208    }
1209    s->encoding = ALAW;
1210    s->sampsize = 1;
1211    if (s->guessRate) {
1212      s->samprate = DEFAULT_ALAW_RATE;
1213    }
1214    break;
1215  case GUESS_MULAW:
1216    if (s->sampsize == 2) {
1217      s->length *= 2;
1218    }
1219    s->encoding = MULAW;
1220    s->sampsize = 1;
1221    if (s->guessRate) {
1222      s->samprate = DEFAULT_MULAW_RATE;
1223    }
1224    break;
1225  case GUESS_LIN8OFFSET:
1226    if (s->sampsize == 2) {
1227      s->length *= 2;
1228    }
1229    s->encoding = LIN8OFFSET;
1230    s->sampsize = 1;
1231    if (s->guessRate) {
1232      s->samprate = DEFAULT_LIN8OFFSET_RATE;
1233    }
1234    break;
1235  case GUESS_LIN8:
1236    if (s->sampsize == 2) {
1237      s->length *= 2;
1238    }
1239    s->encoding = LIN8;
1240    s->sampsize = 1;
1241    if (s->guessRate) {
1242      s->samprate = DEFAULT_LIN8_RATE;
1243    }
1244    break;
1245  case GUESS_LIN24:
1246    s->swap = 0;
1247    s->encoding = LIN24;
1248    s->sampsize = 4;
1249    break;
1250  case GUESS_LIN24S:
1251    s->swap = 1;
1252    s->encoding = LIN24;
1253    s->sampsize = 4;
1254    break;
1255  }
1256
1257  if (s->guessRate && s->encoding == LIN16) {
1258    for (i = 0; i < GUESS_FFT_LENGTH; i++) {
1259      totfft[i] = 0.0;
1260    }
1261    Snack_InitFFT(GUESS_FFT_LENGTH);
1262    Snack_InitWindow(hamwin, GUESS_FFT_LENGTH, GUESS_FFT_LENGTH / 2,
1263		     SNACK_DEFAULT_GFWINTYPE);
1264    for (i = 0; i < (len / s->sampsize) / (GUESS_FFT_LENGTH + 1); i++) {
1265      for (j = 0; j < GUESS_FFT_LENGTH; j++) {
1266	short sample  = ((short *)buf)[j + i * (GUESS_FFT_LENGTH / 2)];
1267	if (s->swap) {
1268	  sample = Snack_SwapShort(sample);
1269	}
1270	fft[j] = (float) sample * hamwin[j];
1271      }
1272      Snack_DBPowerSpectrum(fft);
1273      for (j = 0; j < GUESS_FFT_LENGTH / 2; j++) {
1274	totfft[j] += fft[j];
1275      }
1276    }
1277    for (i = 0; i < GUESS_FFT_LENGTH / 2; i++) {
1278      if (totfft[i] < minBin) minBin = totfft[i];
1279    }
1280    for (i = 0; i < GUESS_FFT_LENGTH / 2; i++) {
1281      toterg += (totfft[i] - minBin);
1282    }
1283    for (i = 0; i < GUESS_FFT_LENGTH / 2; i++) {
1284      cmperg += (totfft[i] - minBin);
1285      if (cmperg > toterg / 2.0) break;
1286    }
1287
1288    if (i > 100) {
1289      /* Silence, don't guess */
1290    } else if (i > 64) {
1291      s->samprate = 8000;
1292    } else if (i > 46) {
1293      s->samprate = 11025;
1294    } else if (i > 32) {
1295      s->samprate = 16000;
1296    } else if (i > 23) {
1297      s->samprate = 22050;
1298    } else if (i > 16) {
1299      s->samprate = 32000;
1300    } else if (i > 11) {
1301      s->samprate = 44100;
1302    }
1303  }
1304
1305  if (s->debug > 2) Snack_WriteLogInt("    Exit GuessEncoding", s->encoding);
1306
1307  return TCL_OK;
1308}
1309
1310static int
1311GetRawHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1312	     char *buf)
1313{
1314  if (s->debug > 2) Snack_WriteLog("    Reading RAW header\n");
1315
1316  if (ch != NULL) {
1317    TCL_SEEK(ch, 0, SEEK_END);
1318    s->length = (TCL_TELL(ch) - s->skipBytes) / (s->sampsize * s->nchannels);
1319  }
1320  if (obj != NULL) {
1321    if (useOldObjAPI) {
1322      s->length = (obj->length  - s->skipBytes) / (s->sampsize * s->nchannels);
1323    } else {
1324#ifdef TCL_81_API
1325      int length = 0;
1326
1327      Tcl_GetByteArrayFromObj(obj, &length);
1328      s->length = (length - s->skipBytes) / (s->sampsize * s->nchannels);
1329#endif
1330    }
1331  }
1332  s->headSize = s->skipBytes;
1333
1334  return TCL_OK;
1335}
1336
1337static int
1338PutRawHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1339	     int objc, Tcl_Obj *CONST objv[], int len)
1340{
1341  s->headSize = 0;
1342
1343  return TCL_OK;
1344}
1345
1346#define NIST_HEADERSIZE 1024
1347
1348static int
1349GetSmpHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1350	     char *buf)
1351{
1352  char s1[100], s2[100];
1353  int i = 0, cont = 1;
1354
1355  if (s->debug > 2) Snack_WriteLog("    Reading SMP header\n");
1356
1357  if (s->firstNRead < NIST_HEADERSIZE) {
1358    if (Tcl_Read(ch, (char *)&buf[s->firstNRead],
1359		 NIST_HEADERSIZE-s->firstNRead) < 0) {
1360      return TCL_ERROR;
1361    }
1362  }
1363
1364  do {
1365    sscanf(&buf[i], "%s", s1);
1366    if (strncmp(s1, "sftot", 5) == 0) {
1367      sscanf(&buf[i+6], "%d", &s->samprate);
1368      if (s->debug > 3) {
1369	Snack_WriteLogInt("      Setting rate", s->samprate);
1370      }
1371    } else if (strncmp(s1, "msb", 3) == 0) {
1372      sscanf(&buf[i+4], "%s", s2);
1373      if (s->debug > 3) {
1374	Snack_WriteLog("      ");
1375	Snack_WriteLog(s2);
1376	Snack_WriteLog(" byte order\n");
1377      }
1378    } else if (strncmp(s1, "nchans", 6) == 0) {
1379      sscanf(&buf[i+7], "%d", &s->nchannels);
1380      if (s->debug > 3) {
1381	Snack_WriteLogInt("      Setting number of channels", s->nchannels);
1382      }
1383    } else if (buf[i] == 0) {
1384      cont = 0;
1385    }
1386    while (buf[i] != 10 && buf[i] != 0) i++;
1387    i++;
1388  } while (cont);
1389
1390  s->encoding = LIN16;
1391  s->sampsize = 2;
1392  s->swap = 0;
1393
1394  if (ch != NULL) {
1395    TCL_SEEK(ch, 0, SEEK_END);
1396    s->length = (TCL_TELL(ch) - NIST_HEADERSIZE) / (s->sampsize * s->nchannels);
1397  }
1398  if (obj != NULL) {
1399    if (useOldObjAPI) {
1400      s->length = (obj->length - NIST_HEADERSIZE) / (s->sampsize * s->nchannels);
1401    } else {
1402#ifdef TCL_81_API
1403      int length = 0;
1404
1405      Tcl_GetByteArrayFromObj(obj, &length);
1406      s->length = (length - NIST_HEADERSIZE) / (s->sampsize * s->nchannels);
1407#endif
1408    }
1409  }
1410  s->headSize = NIST_HEADERSIZE;
1411  if (strcmp(s2, "first") == 0) {
1412    if (littleEndian) {
1413      SwapIfLE(s);
1414    }
1415  } else {
1416    if (!littleEndian) {
1417      SwapIfBE(s);
1418    }
1419  }
1420
1421  return TCL_OK;
1422}
1423
1424static int
1425PutSmpHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1426	     int objc, Tcl_Obj *CONST objv[], int len)
1427{
1428  int i = 0;
1429  char buf[HEADBUF];
1430
1431  if (s->encoding != LIN16) {
1432    Tcl_AppendResult(interp, "Unsupported encoding format", NULL);
1433    return -1;
1434  }
1435
1436  i += (int) sprintf(&buf[i], "file=samp\r\n");
1437  i += (int) sprintf(&buf[i], "sftot=%d\r\n", s->samprate);
1438  if (littleEndian) {
1439    i += (int) sprintf(&buf[i], "msb=last\r\n");
1440  } else {
1441    i += (int) sprintf(&buf[i], "msb=first\r\n");
1442  }
1443  i += (int) sprintf(&buf[i], "nchans=%d\r\n", s->nchannels);
1444  i += (int) sprintf(&buf[i],"preemph=none\r\nborn=snack\r\n=\r\n%c%c%c", 0,4,26);
1445
1446  for (;i < NIST_HEADERSIZE; i++) buf[i] = 0;
1447
1448  if (ch != NULL) {
1449    if (Tcl_Write(ch, buf, NIST_HEADERSIZE) == -1) {
1450      Tcl_AppendResult(interp, "Error while writing header", NULL);
1451      return -1;
1452    }
1453  } else {
1454    if (useOldObjAPI) {
1455      Tcl_SetObjLength(obj, NIST_HEADERSIZE);
1456      memcpy(obj->bytes, buf, NIST_HEADERSIZE);
1457    } else {
1458#ifdef TCL_81_API
1459      unsigned char *p = Tcl_SetByteArrayLength(obj, NIST_HEADERSIZE);
1460      memcpy(p, buf, NIST_HEADERSIZE);
1461#endif
1462    }
1463  }
1464  s->inByteOrder = SNACK_NATIVE;
1465  s->swap = 0;
1466  s->headSize = NIST_HEADERSIZE;
1467
1468  return TCL_OK;
1469}
1470
1471#define SNACK_SD_INT 20
1472
1473static int
1474GetSdHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1475	    char *buf)
1476{
1477  int datastart, len, i, j;
1478  double freq = 16000.0;
1479  double start = 0.0;
1480  int first = 1;
1481
1482  if (s->debug > 2) Snack_WriteLog("    Reading SD header\n");
1483
1484  datastart = GetBELong(buf, 8);
1485  s->nchannels = GetBELong(buf, 144);
1486
1487  for (i = 0; i < s->firstNRead; i++) {
1488    if (strncasecmp("record_freq", &buf[i], strlen("record_freq")) == 0) {
1489      i = i + 18;
1490      if (littleEndian) {
1491	for (j = 0; j < 4; j++) {
1492	  char c = buf[i+j];
1493
1494	  buf[i+j] = buf[i+7-j];
1495	  buf[i+7-j] = c;
1496	}
1497      }
1498      memcpy(&freq, &buf[i], 8);
1499    }
1500    if (strncasecmp("start_time", &buf[i], strlen("start_time")) == 0 && first) {
1501      first = 0;
1502      i = i + 18;
1503      if (littleEndian) {
1504	for (j = 0; j < 4; j++) {
1505	  char c = buf[i+j];
1506
1507	  buf[i+j] = buf[i+7-j];
1508	  buf[i+7-j] = c;
1509	}
1510      }
1511      memcpy(&start, &buf[i], 8);
1512
1513      if (s->extHead != NULL && s->extHeadType != SNACK_SD_INT) {
1514	Snack_FileFormat *ff;
1515
1516	for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
1517	  if (strcmp(s->fileType, ff->name) == 0) {
1518	    if (ff->freeHeaderProc != NULL) {
1519	      (ff->freeHeaderProc)(s);
1520	    }
1521	  }
1522	}
1523      }
1524      if (s->extHead == NULL) {
1525	s->extHead = (char *) ckalloc(sizeof(double));
1526	memcpy(s->extHead, &buf[i], sizeof(double));
1527	s->extHeadType = SNACK_SD_INT;
1528      }
1529    }
1530  }
1531
1532  s->encoding = LIN16;
1533  s->sampsize = 2;
1534  s->samprate = (int) freq;
1535  s->loadOffset = 0; /*(int) (start * s->samprate + 0.5);*/
1536
1537  if (ch != NULL) {
1538    TCL_SEEK(ch, 0, SEEK_END);
1539    len = TCL_TELL(ch);
1540    if (len == 0 || len < datastart) {
1541      Tcl_AppendResult(interp, "Failed reading SD header", NULL);
1542      return TCL_ERROR;
1543    }
1544    s->length = (len - datastart) / s->sampsize + s->loadOffset;
1545  }
1546  if (obj != NULL) {
1547    if (useOldObjAPI) {
1548      s->length = obj->length / s->sampsize + s->loadOffset;
1549    } else {
1550#ifdef TCL_81_API
1551      int length = 0;
1552
1553      Tcl_GetByteArrayFromObj(obj, &length);
1554      s->length = length / s->sampsize + s->loadOffset;
1555#endif
1556    }
1557  }
1558  s->length /= s->nchannels;
1559  s->headSize = datastart;
1560  SwapIfLE(s);
1561
1562  return TCL_OK;
1563}
1564
1565static int
1566ConfigSdHeader(Sound *s, Tcl_Interp *interp, int objc,
1567                Tcl_Obj *CONST objv[])
1568{
1569  int index;
1570  static CONST84 char *optionStrings[] = {
1571    "-start_time", NULL
1572  };
1573  enum options {
1574    STARTTIME
1575  };
1576
1577  if (s->extHeadType != SNACK_SD_INT || objc < 3) return 0;
1578
1579  if (objc == 3) { /* get option */
1580    if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0,
1581                            &index) != TCL_OK) {
1582      Tcl_AppendResult(interp, ", or\n", NULL);
1583      return 0;
1584    }
1585
1586    switch ((enum options) index) {
1587    case STARTTIME:
1588      {
1589	double *start = (double *) s->extHead;
1590        Tcl_SetObjResult(interp, Tcl_NewDoubleObj(*start));
1591        break;
1592      }
1593    }
1594  }
1595
1596  return 1;
1597}
1598
1599static void
1600FreeSdHeader(Sound *s)
1601{
1602  if (s->debug > 2) Snack_WriteLog("    Enter FreeSdHeader\n");
1603
1604  if (s->extHead != NULL) {
1605    ckfree((char *)s->extHead);
1606    s->extHead = NULL;
1607    s->extHeadType = 0;
1608  }
1609
1610  if (s->debug > 2) Snack_WriteLog("    Exit FreeSdHeader\n");
1611}
1612
1613#define SND_FORMAT_MULAW_8   1
1614#define SND_FORMAT_LINEAR_8  2
1615#define SND_FORMAT_LINEAR_16 3
1616#define SND_FORMAT_LINEAR_24 4
1617#define SND_FORMAT_LINEAR_32 5
1618#define SND_FORMAT_FLOAT     6
1619#define SND_FORMAT_DOUBLE    7
1620#define SND_FORMAT_ALAW_8    27
1621
1622#define AU_HEADERSIZE 28
1623
1624static int
1625GetAuHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1626	    char *buf)
1627{
1628  int fmt, hlen, nsamp, nsampfile;
1629
1630  if (s->debug > 2) Snack_WriteLog("    Reading AU/SND header\n");
1631
1632  if (s->firstNRead < AU_HEADERSIZE) {
1633    if (Tcl_Read(ch, (char *)&buf[s->firstNRead],
1634		 AU_HEADERSIZE-s->firstNRead) < 0) {
1635      return TCL_ERROR;
1636    }
1637  }
1638  hlen = GetBELong(buf, 4);
1639  fmt  = GetBELong(buf, 12);
1640
1641  switch (fmt) {
1642  case SND_FORMAT_MULAW_8:
1643    s->encoding = MULAW;
1644    s->sampsize = 1;
1645    break;
1646  case SND_FORMAT_LINEAR_8:
1647    s->encoding = LIN8;
1648    s->sampsize = 1;
1649    break;
1650  case SND_FORMAT_LINEAR_16:
1651    s->encoding = LIN16;
1652    s->sampsize = 2;
1653    break;
1654  case SND_FORMAT_LINEAR_24:
1655    s->encoding = LIN24;
1656    s->sampsize = 3;
1657    break;
1658  case SND_FORMAT_LINEAR_32:
1659    s->encoding = LIN32;
1660    s->sampsize = 4;
1661    break;
1662  case SND_FORMAT_FLOAT:
1663    s->encoding = SNACK_FLOAT;
1664    s->sampsize = 4;
1665    break;
1666  case SND_FORMAT_DOUBLE:
1667    s->encoding = SNACK_DOUBLE;
1668    s->sampsize = 4;
1669    break;
1670  case SND_FORMAT_ALAW_8:
1671    s->encoding = ALAW;
1672    s->sampsize = 1;
1673    break;
1674  default:
1675    Tcl_AppendResult(interp, "Unsupported AU format", NULL);
1676    return TCL_ERROR;
1677  }
1678  s->samprate = GetBELong(buf, 16);
1679  s->nchannels = GetBELong(buf, 20);
1680  if (hlen < 24) {
1681    hlen = 24;
1682  }
1683  s->headSize = hlen;
1684  nsamp = GetBELong(buf, 8) / (s->sampsize * s->nchannels);
1685
1686  if (ch != NULL) {
1687    TCL_SEEK(ch, 0, SEEK_END);
1688    nsampfile = (TCL_TELL(ch) - hlen) / (s->sampsize * s->nchannels);
1689    if (nsampfile < nsamp || nsamp <= 0) {
1690      nsamp = nsampfile;
1691    }
1692  }
1693  if (obj != NULL) {
1694    if (useOldObjAPI) {
1695      nsamp = (obj->length - hlen) / (s->sampsize * s->nchannels);
1696    } else {
1697#ifdef TCL_81_API
1698      int length = 0;
1699
1700      Tcl_GetByteArrayFromObj(obj, &length);
1701      nsamp = (length - hlen) / (s->sampsize * s->nchannels);
1702#endif
1703    }
1704  }
1705  if (s->encoding != SNACK_DOUBLE) {
1706    s->length = nsamp;
1707  } else {
1708    s->length = nsamp/2;
1709  }
1710  SwapIfLE(s);
1711
1712  return TCL_OK;
1713}
1714
1715static int
1716PutAuHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1717	    int objc, Tcl_Obj *CONST objv[], int len)
1718{
1719  int fmt = 0;
1720  char buf[HEADBUF];
1721
1722  if (s->debug > 2) Snack_WriteLog("    Saving AU/SND\n");
1723
1724  PutBELong(buf, 0, 0x2E736E64);
1725  PutBELong(buf, 4, AU_HEADERSIZE);
1726  PutBELong(buf, 8, len * s->sampsize * s->nchannels);
1727
1728  switch (s->encoding) {
1729  case MULAW:
1730    fmt = SND_FORMAT_MULAW_8;
1731    break;
1732  case LIN8:
1733    fmt = SND_FORMAT_LINEAR_8;
1734    break;
1735  case LIN16:
1736    fmt = SND_FORMAT_LINEAR_16;
1737    break;
1738  case LIN24:
1739    fmt = SND_FORMAT_LINEAR_24;
1740    break;
1741  case LIN32:
1742    fmt = SND_FORMAT_LINEAR_32;
1743    break;
1744  case SNACK_FLOAT:
1745  case SNACK_DOUBLE:
1746    fmt = SND_FORMAT_FLOAT;
1747    break;
1748  case ALAW:
1749    fmt = SND_FORMAT_ALAW_8;
1750    break;
1751  default:
1752    Tcl_AppendResult(interp, "Unsupported AU format", NULL);
1753    return -1;
1754  }
1755  PutBELong(buf, 12, fmt);
1756
1757  PutBELong(buf, 16, s->samprate);
1758  PutBELong(buf, 20, s->nchannels);
1759  PutBELong(buf, 24, 0);
1760
1761  if (ch != NULL) {
1762    if (Tcl_Write(ch, buf, AU_HEADERSIZE) == -1) {
1763      Tcl_AppendResult(interp, "Error while writing header", NULL);
1764      return -1;
1765    }
1766  } else {
1767    if (useOldObjAPI) {
1768      Tcl_SetObjLength(obj, AU_HEADERSIZE);
1769      memcpy(obj->bytes, buf, AU_HEADERSIZE);
1770    } else {
1771#ifdef TCL_81_API
1772      unsigned char *p = Tcl_SetByteArrayLength(obj, AU_HEADERSIZE);
1773      memcpy(p, buf, AU_HEADERSIZE);
1774#endif
1775    }
1776  }
1777
1778  if (len == -1) {
1779    SwapIfLE(s);
1780  }
1781  s->inByteOrder = SNACK_BIGENDIAN;
1782  s->headSize = AU_HEADERSIZE;
1783
1784  return TCL_OK;
1785}
1786
1787#define WAVE_FORMAT_PCM	1
1788#ifndef WIN
1789#  define WAVE_FORMAT_IEEE_FLOAT 3
1790#  define WAVE_FORMAT_ALAW  6
1791#  define WAVE_FORMAT_MULAW 7
1792#endif
1793#define WAVE_EX		(-2)	/* (OxFFFE) in a 2-byte word */
1794
1795static int
1796GetHeaderBytes(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, char *buf,
1797	       int len)
1798{
1799  int rlen = Tcl_Read(ch, &buf[s->firstNRead], len - s->firstNRead);
1800
1801  if (rlen < len - s->firstNRead){
1802    Tcl_AppendResult(interp, "Failed reading header bytes", NULL);
1803    return TCL_ERROR;
1804  }
1805  s->firstNRead += rlen;
1806
1807  return TCL_OK;
1808}
1809
1810static int
1811GetWavHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1812	     char *buf)
1813{
1814  int fmt, nsamp = 0, nsampfile, i = 12, chunkLen;
1815
1816  if (s->debug > 2) Snack_WriteLog("    Reading WAV header\n");
1817
1818  /* buf[] = "RIFFxxxxWAVE" */
1819
1820  while (1) {
1821    if (strncasecmp("fmt ", &buf[i], strlen("fmt ")) == 0) {
1822      chunkLen = GetLELong(buf, i + 4) + 8;
1823      if (s->firstNRead < i + chunkLen) {
1824	if (GetHeaderBytes(s, interp, ch, buf, i + chunkLen) != TCL_OK) {
1825	  return TCL_ERROR;
1826	}
1827      }
1828      fmt = GetLEShort(buf, i+8);
1829      s->nchannels = GetLEShort(buf, i+10);
1830      s->samprate  = GetLELong(buf, i+12);
1831      s->sampsize  = GetLEShort(buf, i+22) / 8;
1832
1833      /* For WAVE-EX, the format is the first two bytes of the GUID */
1834      if (fmt == WAVE_EX)
1835	fmt = GetLEShort(buf, i+32);
1836
1837      switch (fmt) {
1838      case WAVE_FORMAT_PCM:
1839	if (s->sampsize == 1) {
1840	  s->encoding = LIN8OFFSET;
1841	} else if (s->sampsize == 2) {
1842	  s->encoding = LIN16;
1843	} else if (s->sampsize == 3) {
1844	  s->encoding = LIN24;
1845	} else if (s->sampsize == 4) {
1846	  s->encoding = LIN32;
1847	}
1848	break;
1849      case WAVE_FORMAT_IEEE_FLOAT:
1850	if (s->sampsize == 4) {
1851	  s->encoding = SNACK_FLOAT;
1852	} else {
1853	  s->encoding = SNACK_DOUBLE;
1854	}
1855	s->sampsize = 4;
1856	break;
1857      case WAVE_FORMAT_ALAW:
1858	s->encoding = ALAW;
1859	break;
1860      case WAVE_FORMAT_MULAW:
1861	s->encoding = MULAW;
1862	break;
1863      default:
1864	Tcl_AppendResult(interp, "Unsupported WAV format", NULL);
1865	return TCL_ERROR;
1866      }
1867
1868      if (s->debug > 3) {
1869	Snack_WriteLogInt("      fmt chunk parsed", chunkLen);
1870      }
1871    } else if (strncasecmp("data", &buf[i], strlen("data")) == 0) {
1872      nsamp = GetLELong(buf, i + 4) / (s->sampsize * s->nchannels);
1873      if (s->debug > 3) {
1874	Snack_WriteLogInt("      data chunk parsed", nsamp);
1875      }
1876      break;
1877    } else { /* unknown chunk */
1878      chunkLen = GetLELong(buf, i + 4) + 8;
1879
1880      if (chunkLen < 0) {
1881	Tcl_AppendResult(interp, "Failed parsing WAV header", NULL);
1882	return TCL_ERROR;
1883      }
1884      while (s->firstNRead < i + chunkLen) {
1885	if (GetHeaderBytes(s, interp, ch, buf, i + chunkLen) != TCL_OK) {
1886	  return TCL_ERROR;
1887	}
1888      }
1889      if (s->debug > 3) {
1890	Snack_WriteLogInt("      Skipping unknown chunk", chunkLen);
1891      }
1892    }
1893
1894    i += chunkLen;
1895    if (s->firstNRead < i + 8) {
1896      if (GetHeaderBytes(s, interp, ch, buf, i + 8) != TCL_OK) {
1897	return TCL_ERROR;
1898      }
1899    }
1900    if (i >= HEADBUF) {
1901      Tcl_AppendResult(interp, "Failed parsing WAV header", NULL);
1902      return TCL_ERROR;
1903    }
1904  }
1905
1906  s->headSize = i + 8;
1907  if (ch != NULL) {
1908    TCL_SEEK(ch, 0, SEEK_END);
1909    nsampfile = (TCL_TELL(ch) - s->headSize) / (s->sampsize * s->nchannels);
1910    if (nsampfile < nsamp || nsamp == 0) {
1911      nsamp = nsampfile;
1912    }
1913  }
1914  if (obj != NULL) {
1915    if (useOldObjAPI) {
1916      nsampfile = (obj->length - s->headSize) / (s->sampsize * s->nchannels);
1917    } else {
1918#ifdef TCL_81_API
1919      int length = 0;
1920
1921      Tcl_GetByteArrayFromObj(obj, &length);
1922      nsampfile = (length - s->headSize) / (s->sampsize * s->nchannels);
1923#endif
1924    }
1925    if (nsampfile < nsamp || nsamp == 0) {
1926      nsamp = nsampfile;
1927    }
1928  }
1929
1930  if (s->encoding != SNACK_DOUBLE) {
1931    s->length = nsamp;
1932  } else {
1933    s->length = nsamp/2;
1934  }
1935
1936  if (s->sampsize == 4 && s->encoding == LIN32) {
1937    double energyLIN32 = 0.0, energyFLOAT = 0.0;
1938
1939    for (i = s->headSize; i < s->firstNRead / 4; i++) {
1940      int   sampleLIN32 = ((int   *)buf)[i];
1941      float sampleFLOAT = ((float *)buf)[i];
1942      if (!littleEndian) {
1943	sampleLIN32 = Snack_SwapLong(sampleLIN32);
1944	sampleFLOAT = Snack_SwapFloat(sampleFLOAT);
1945      }
1946      energyLIN32 += (double) (sampleLIN32 * sampleLIN32);
1947      energyFLOAT += (double) (sampleFLOAT * sampleFLOAT);
1948    }
1949    if (fabs(energyLIN32) > fabs(energyFLOAT)) {
1950      s->encoding = SNACK_FLOAT;
1951    }
1952  }
1953
1954  SwapIfBE(s);
1955
1956  return TCL_OK;
1957}
1958
1959#define SNACK_WAV_HEADERSIZE 44
1960
1961static int
1962PutWavHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
1963	     int objc, Tcl_Obj *CONST objv[], int len)
1964{
1965  char buf[HEADBUF];
1966
1967  sprintf(&buf[0], "RIFF");
1968  if (len != -1) {
1969    PutLELong(buf, 4, len * s->sampsize * s->nchannels + 36);
1970  } else {
1971    SwapIfBE(s);
1972    PutLELong(buf, 4, 0x7FFFFFFF);
1973  }
1974  sprintf(&buf[8], "WAVEfmt ");
1975  PutLELong(buf, 16, 16);
1976
1977  switch (s->encoding) {
1978  case ALAW:
1979    PutLEShort(buf, 20, WAVE_FORMAT_ALAW);
1980    break;
1981  case MULAW:
1982    PutLEShort(buf, 20, WAVE_FORMAT_MULAW);
1983    break;
1984  case SNACK_FLOAT:
1985  case SNACK_DOUBLE:
1986    PutLEShort(buf, 20, WAVE_FORMAT_IEEE_FLOAT);
1987    break;
1988  default:
1989    PutLEShort(buf, 20, WAVE_FORMAT_PCM);
1990  }
1991  PutLEShort(buf, 22, (short)s->nchannels);
1992  PutLELong(buf, 24, s->samprate);
1993  PutLELong(buf, 28, (s->samprate * s->nchannels * s->sampsize * 8 + 7) / 8);
1994  PutLEShort(buf, 32, (short)((s->nchannels * s->sampsize * 8 + 7) / 8));
1995  PutLEShort(buf, 34, (short) (s->sampsize * 8));
1996  sprintf(&buf[36], "data");
1997  if (len != -1) {
1998    PutLELong(buf, 40, len * s->sampsize * s->nchannels);
1999  } else {
2000    PutLELong(buf, 40, 0x7FFFFFDB);
2001  }
2002  if (ch != NULL) {
2003    if (Tcl_Write(ch, buf, SNACK_WAV_HEADERSIZE) == -1) {
2004      Tcl_AppendResult(interp, "Error while writing header", NULL);
2005      return -1;
2006    }
2007  } else {
2008    if (useOldObjAPI) {
2009      Tcl_SetObjLength(obj, SNACK_WAV_HEADERSIZE);
2010      memcpy(obj->bytes, buf, SNACK_WAV_HEADERSIZE);
2011    } else {
2012#ifdef TCL_81_API
2013      unsigned char *p = Tcl_SetByteArrayLength(obj, SNACK_WAV_HEADERSIZE);
2014      memcpy(p, buf, SNACK_WAV_HEADERSIZE);
2015#endif
2016    }
2017  }
2018  s->inByteOrder = SNACK_LITTLEENDIAN;
2019  s->headSize = SNACK_WAV_HEADERSIZE;
2020
2021  return TCL_OK;
2022}
2023
2024/* See http://www.borg.com/~jglatt/tech/aiff.htm */
2025
2026static uint32_t
2027ConvertFloat(unsigned char *buffer)
2028{
2029  uint32_t mantissa;
2030  uint32_t last = 0;
2031  unsigned char exp;
2032
2033  memcpy(&mantissa, buffer + 2, sizeof(int32_t));
2034  if (littleEndian) {
2035    mantissa = Snack_SwapLong(mantissa);
2036  }
2037  exp = 30 - *(buffer+1);
2038  while (exp--) {
2039    last = mantissa;
2040    mantissa >>= 1;
2041  }
2042  if (last & 0x00000001) mantissa++;
2043  return(mantissa);
2044}
2045
2046static void
2047StoreFloat(unsigned char * buffer, uint32_t value)
2048{
2049  uint32_t exp;
2050  unsigned char i;
2051
2052  memset(buffer, 0, 10);
2053
2054  exp = value;
2055  exp >>= 1;
2056  for (i=0; i<32; i++) {
2057    exp >>= 1;
2058    if (!exp) break;
2059  }
2060  *(buffer+1) = i;
2061
2062  for (i=32; i; i--) {
2063    if (value & 0x80000000) break;
2064    value <<= 1;
2065  }
2066
2067  if (littleEndian) {
2068    value = Snack_SwapLong(value);
2069  }
2070  buffer[0] = 0x40;
2071  memcpy(buffer + 2, &value, sizeof(int32_t));
2072}
2073
2074#define ICEILV(n,m)	(((n) + ((m) - 1)) / (m))	/* int n,m >= 0 */
2075#define RNDUPV(n,m)	((m) * ICEILV (n, m))		/* Round up */
2076
2077static int
2078GetAiffHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
2079	      char *buf)
2080{
2081  int bits = 0, offset = 0, i = 12, chunkLen = 4;
2082
2083  if (s->debug > 2) Snack_WriteLog("    Reading AIFF header\n");
2084
2085  /* buf[] = "FORMxxxxAIFF" */
2086
2087  while (1) {
2088    if (strncasecmp("COMM", &buf[i], strlen("COMM")) == 0) {
2089      chunkLen = GetBELong(buf, i + 4) + 8;
2090      if (s->firstNRead < i + chunkLen) {
2091	if (GetHeaderBytes(s, interp, ch, buf, i + chunkLen) != TCL_OK) {
2092	  return TCL_ERROR;
2093	}
2094      }
2095      s->nchannels = GetBEShort(buf, i + 8);
2096      bits = GetBEShort(buf, i + 14);
2097      bits = RNDUPV (bits, 8);
2098      switch (bits) {
2099      case 8:
2100	s->encoding = LIN8;
2101	s->sampsize = 1;
2102	break;
2103      case 16:
2104	s->encoding = LIN16;
2105	s->sampsize = 2;
2106	break;
2107      case 24:
2108	s->encoding = LIN24;
2109	s->sampsize = 3;
2110	break;
2111      case 32:
2112	s->encoding = LIN32;
2113	s->sampsize = 4;
2114	break;
2115      default:
2116	Tcl_AppendResult(interp, "Unsupported AIFF format", NULL);
2117	return TCL_ERROR;
2118      }
2119      s->samprate = ConvertFloat((unsigned char *)&buf[i+16]);
2120      if (s->debug > 3) {
2121	Snack_WriteLogInt("      COMM chunk parsed", chunkLen);
2122      }
2123    } else if (strncasecmp("SSND", &buf[i], strlen("SSND")) == 0) {
2124      chunkLen = 16;
2125      if (s->firstNRead < i + chunkLen) {
2126	if (GetHeaderBytes(s, interp, ch, buf, i + 8) != TCL_OK) {
2127	  return TCL_ERROR;
2128	}
2129      }
2130      s->length = (GetBELong(buf, i + 4) - 8) / (s->sampsize * s->nchannels);
2131      offset = GetBELong(buf, i + 8);
2132      i += chunkLen;
2133      if (s->debug > 3) {
2134	Snack_WriteLogInt("      SSND chunk parsed", chunkLen);
2135      }
2136      break;
2137    } else {
2138      if (i > HEADBUF - 4) {
2139	Tcl_AppendResult(interp, "Missing chunk in AIFF header", NULL);
2140	return TCL_ERROR;
2141      } else {
2142	if (s->debug > 3) {
2143	  char chunkStr[5];
2144
2145	  strncpy(chunkStr, &buf[i], 4);
2146	  chunkStr[4] = '\0';
2147	  Snack_WriteLog(chunkStr);
2148	  Snack_WriteLog(" chunk skipped\n");
2149	}
2150	chunkLen = GetBELong(buf, i + 4) + 8;
2151      }
2152    }
2153    i += chunkLen;
2154    if (s->firstNRead < i + 8) {
2155      if (GetHeaderBytes(s, interp, ch, buf, i + 8) != TCL_OK) {
2156	return TCL_ERROR;
2157      }
2158    }
2159  }
2160  s->headSize = i + offset;
2161  SwapIfLE(s);
2162
2163  return TCL_OK;
2164}
2165
2166#define SNACK_AIFF_HEADERSIZE 54
2167
2168int
2169PutAiffHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
2170	      int objc, Tcl_Obj *CONST objv[], int len)
2171{
2172  char buf[HEADBUF];
2173
2174  if (s->encoding == LIN8OFFSET || s->encoding == ALAW ||
2175      s->encoding == MULAW || s->encoding == SNACK_FLOAT) {
2176    Tcl_AppendResult(interp, "Unsupported encoding format", NULL);
2177    return -1;
2178  }
2179
2180  sprintf(&buf[0], "FORM");
2181  if (len != -1) {
2182    PutBELong(buf, 4, len * s->sampsize * s->nchannels + 46);
2183  } else {
2184    SwapIfLE(s);
2185    PutBELong(buf, 4, 0x7FFFFFFF);
2186  }
2187  sprintf(&buf[8], "AIFFCOMM");
2188  PutBELong(buf, 16, 18);
2189  PutBEShort(buf, 20, (short) s->nchannels);
2190  PutBELong(buf, 22, s->length);
2191  PutBEShort(buf, 26, (short) (s->sampsize * 8));
2192  StoreFloat((unsigned char *) &buf[28], (int32_t) s->samprate);
2193  sprintf(&buf[38], "SSND");
2194  if (len != -1) {
2195    PutBELong(buf, 42, 8 + s->length * s->sampsize * s->nchannels);
2196  } else {
2197    PutBELong(buf, 42, 8 + 0x7FFFFFD1);
2198  }
2199  PutBELong(buf, 46, 0);
2200  PutBELong(buf, 50, 0);
2201  if (ch != NULL) {
2202    if (Tcl_Write(ch, buf, SNACK_AIFF_HEADERSIZE) == -1) {
2203      Tcl_AppendResult(interp, "Error while writing header", NULL);
2204      return -1;
2205    }
2206  } else {
2207    if (useOldObjAPI) {
2208      Tcl_SetObjLength(obj, SNACK_AIFF_HEADERSIZE);
2209      memcpy(obj->bytes, buf, SNACK_AIFF_HEADERSIZE);
2210    } else {
2211#ifdef TCL_81_API
2212      unsigned char *p = Tcl_SetByteArrayLength(obj, SNACK_AIFF_HEADERSIZE);
2213      memcpy(p, buf, SNACK_AIFF_HEADERSIZE);
2214#endif
2215    }
2216  }
2217  s->inByteOrder = SNACK_BIGENDIAN;
2218  s->headSize = SNACK_AIFF_HEADERSIZE;
2219
2220  return TCL_OK;
2221}
2222
2223static int
2224GetCslHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
2225	     char *buf)
2226{
2227  int tmp1, tmp2, nsamp = 0, nsampfile, i = 12, chunkLen;
2228
2229  if (s->debug > 2) Snack_WriteLog("    Reading CSL header\n");
2230
2231  /* buf[] = "FORMDS16xxxxHEDR" */
2232
2233  while (1) {
2234    if (strncasecmp("HEDR", &buf[i], strlen("HEDR")) == 0) {
2235      chunkLen = GetLELong(buf, i + 4) + 8;
2236      if (s->firstNRead < i + chunkLen) {
2237	if (GetHeaderBytes(s, interp, ch, buf, i + chunkLen) != TCL_OK) {
2238	  return TCL_ERROR;
2239	}
2240      }
2241      s->encoding = LIN16;
2242      s->sampsize   = 2;
2243      s->nchannels  = 1;
2244      s->samprate   = GetLELong(buf, i+28);
2245      tmp1 = GetLEShort(buf, i+36);
2246      tmp2 = GetLEShort(buf, i+38);
2247      if (tmp1 != -1 && tmp2 != -1) {
2248	s->nchannels = 2;
2249      }
2250      if (s->debug > 3) {
2251	Snack_WriteLogInt("      HEDR block parsed", chunkLen);
2252      }
2253    } else if (strncasecmp("HDR8", &buf[i], strlen("HDR8")) == 0) {
2254      chunkLen = GetLELong(buf, i + 4) + 8;
2255      if (s->firstNRead < i + chunkLen) {
2256	if (GetHeaderBytes(s, interp, ch, buf, i + chunkLen) != TCL_OK) {
2257	  return TCL_ERROR;
2258	}
2259      }
2260      s->encoding = LIN16;
2261      s->sampsize   = 2;
2262      s->nchannels  = 1;
2263      s->samprate   = GetLELong(buf, i+28);
2264      tmp1 = GetLEShort(buf, i+36);
2265      tmp2 = GetLEShort(buf, i+38);
2266      if (tmp1 != -1 && tmp2 != -1) {
2267	s->nchannels = 2;
2268      }
2269      if (s->debug > 3) {
2270	Snack_WriteLogInt("      HDR8 block parsed", chunkLen);
2271      }
2272    } else if (strncasecmp("SDA_", &buf[i], strlen("SDA_")) == 0) {
2273      s->nchannels  = 1;
2274      nsamp = GetLELong(buf, i + 4) / (s->sampsize * s->nchannels);
2275      if (s->debug > 3) {
2276	Snack_WriteLogInt("      SDA_ block parsed", nsamp);
2277      }
2278      break;
2279    } else if (strncasecmp("SD_B", &buf[i], strlen("SD_B")) == 0) {
2280      s->nchannels  = 1;
2281      nsamp = GetLELong(buf, i + 4) / (s->sampsize * s->nchannels);
2282      if (s->debug > 3) {
2283	Snack_WriteLogInt("      SD_B block parsed", nsamp);
2284      }
2285      break;
2286    } else if (strncasecmp("SDAB", &buf[i], strlen("SDAB")) == 0) {
2287      nsamp = GetLELong(buf, i + 4) / (s->sampsize * s->nchannels);
2288      if (s->debug > 3) {
2289	Snack_WriteLogInt("      SDAB block parsed", nsamp);
2290      }
2291      break;
2292    } else { /* unknown block */
2293      chunkLen = GetLELong(buf, i + 4) + 8;
2294      if (chunkLen & 1) chunkLen++;
2295      if (chunkLen < 0 || chunkLen > HEADBUF) {
2296	Tcl_AppendResult(interp, "Failed parsing CSL header", NULL);
2297	return TCL_ERROR;
2298      }
2299      if (s->firstNRead < i + chunkLen) {
2300	if (GetHeaderBytes(s, interp, ch, buf, i + chunkLen) != TCL_OK) {
2301	  return TCL_ERROR;
2302	}
2303      }
2304      if (s->debug > 3) {
2305	Snack_WriteLogInt("      Skipping unknown block", chunkLen);
2306      }
2307    }
2308
2309    i += chunkLen;
2310    if (s->firstNRead < i + 8) {
2311      if (GetHeaderBytes(s, interp, ch, buf, i + 8) != TCL_OK) {
2312	return TCL_ERROR;
2313      }
2314    }
2315    if (i >= HEADBUF) {
2316      Tcl_AppendResult(interp, "Failed parsing CSL header", NULL);
2317      return TCL_ERROR;
2318    }
2319  }
2320
2321  s->headSize = i + 8;
2322  if (ch != NULL) {
2323    TCL_SEEK(ch, 0, SEEK_END);
2324    nsampfile = (TCL_TELL(ch) - s->headSize) / (s->sampsize * s->nchannels);
2325    if (nsampfile < nsamp || nsamp == 0) {
2326      nsamp = nsampfile;
2327    }
2328  }
2329  if (obj != NULL) {
2330    if (useOldObjAPI) {
2331      nsampfile = (obj->length - s->headSize) / (s->sampsize * s->nchannels);
2332    } else {
2333#ifdef TCL_81_API
2334      int length = 0;
2335
2336      Tcl_GetByteArrayFromObj(obj, &length);
2337      nsampfile = (length - s->headSize) / (s->sampsize * s->nchannels);
2338#endif
2339    }
2340    if (nsampfile < nsamp || nsamp == 0) {
2341      nsamp = nsampfile;
2342    }
2343  }
2344  s->length = nsamp;
2345  SwapIfBE(s);
2346
2347  return TCL_OK;
2348}
2349
2350#define SNACK_CSL_HEADERSIZE 88
2351#define CSL_DATECOMMAND "clock format [clock seconds] -format {%b %d %T %Y}"
2352
2353static int
2354PutCslHeader(Sound *s, Tcl_Interp *interp, Tcl_Channel ch, Tcl_Obj *obj,
2355	     int objc, Tcl_Obj *CONST objv[], int len)
2356{
2357  char buf[HEADBUF];
2358
2359  if (s->encoding != LIN16) {
2360    Tcl_AppendResult(interp, "Unsupported encoding format", NULL);
2361    return -1;
2362  }
2363
2364  sprintf(&buf[0], "FORMDS16");
2365  if (len != -1) {
2366    PutLELong(buf, 8, len * s->sampsize * s->nchannels + 76);
2367  } else {
2368    SwapIfBE(s);
2369    PutLELong(buf, 8, 0);
2370  }
2371  sprintf(&buf[12], "HEDR");
2372  PutLELong(buf, 16, 32);
2373  Tcl_GlobalEvalObj(s->interp, Tcl_NewStringObj(CSL_DATECOMMAND, -1));
2374  sprintf(&buf[20], Tcl_GetStringResult(s->interp));
2375
2376  PutLELong(buf, 40, s->samprate);
2377  PutLELong(buf, 44, s->length);
2378  PutLEShort(buf, 48, (short) s->abmax);
2379  if (s->nchannels == 1) {
2380    PutLEShort(buf, 50, (short) -1);
2381  } else {
2382    PutLEShort(buf, 50, (short) s->abmax);
2383  }
2384
2385  sprintf(&buf[52], "NOTE");
2386  PutLELong(buf, 56, 19);
2387  sprintf(&buf[60], "Created by Snack   ");
2388
2389  if (s->nchannels == 1) {
2390    sprintf(&buf[80], "SDA_");
2391  } else {
2392    sprintf(&buf[80], "SDAB");
2393  }
2394  if (len != -1) {
2395    PutLELong(buf, 84, len * s->sampsize * s->nchannels);
2396  } else {
2397    PutLELong(buf, 84, 0);
2398  }
2399  if (ch != NULL) {
2400    if (Tcl_Write(ch, buf, SNACK_CSL_HEADERSIZE) == -1) {
2401      Tcl_AppendResult(interp, "Error while writing header", NULL);
2402      return -1;
2403    }
2404  } else {
2405    if (useOldObjAPI) {
2406      Tcl_SetObjLength(obj, SNACK_CSL_HEADERSIZE);
2407      memcpy(obj->bytes, buf, SNACK_CSL_HEADERSIZE);
2408    } else {
2409#ifdef TCL_81_API
2410      unsigned char *p = Tcl_SetByteArrayLength(obj, SNACK_CSL_HEADERSIZE);
2411      memcpy(p, buf, SNACK_CSL_HEADERSIZE);
2412#endif
2413    }
2414  }
2415  s->inByteOrder = SNACK_LITTLEENDIAN;
2416  s->headSize = SNACK_CSL_HEADERSIZE;
2417
2418  return TCL_OK;
2419}
2420
2421int
2422SnackOpenFile(openProc *openProc, Sound *s, Tcl_Interp *interp,
2423	      Tcl_Channel *ch, char *mode)
2424{
2425  int permissions;
2426
2427  if (strcmp(mode, "r") == 0) {
2428    permissions = 0;
2429  } else {
2430    permissions = 420;
2431  }
2432  if (openProc == NULL) {
2433    if ((*ch = Tcl_OpenFileChannel(interp, s->fcname, mode, permissions))==0) {
2434      return TCL_ERROR;
2435    }
2436    Tcl_SetChannelOption(interp, *ch, "-translation", "binary");
2437#ifdef TCL_81_API
2438    Tcl_SetChannelOption(interp, *ch, "-encoding", "binary");
2439#endif
2440  } else {
2441    return((openProc)(s, interp, ch, mode));
2442  }
2443
2444  return TCL_OK;
2445}
2446
2447int
2448SnackCloseFile(closeProc *closeProc, Sound *s, Tcl_Interp *interp,
2449	       Tcl_Channel *ch)
2450{
2451  if (closeProc == NULL) {
2452    Tcl_Close(interp, *ch);
2453    *ch = NULL;
2454  } else {
2455    return((closeProc)(s, interp, ch));
2456  }
2457
2458  return TCL_OK;
2459}
2460
2461int
2462SnackSeekFile(seekProc *seekProc, Sound *s, Tcl_Interp *interp,
2463	      Tcl_Channel ch, int pos)
2464{
2465  if (seekProc == NULL) {
2466    return(TCL_SEEK(ch, s->headSize + pos * s->sampsize * s->nchannels,
2467		    SEEK_SET));
2468  } else {
2469    return((seekProc)(s, interp, ch, pos));
2470  }
2471}
2472
2473char *
2474LoadSound(Sound *s, Tcl_Interp *interp, Tcl_Obj *obj, int startpos,
2475	  int endpos)
2476{
2477  Tcl_Channel ch = NULL;
2478  int status = TCL_OK;
2479  Snack_FileFormat *ff;
2480  int oldsampfmt = s->encoding;
2481
2482  if (s->debug > 1) Snack_WriteLog("  Enter LoadSound\n");
2483
2484  if (GetHeader(s, interp, obj) != TCL_OK) {
2485    return NULL;
2486  }
2487  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
2488    if (strcmp(s->fileType, ff->name) == 0) {
2489      int pos = 0;
2490      if (obj == NULL) {
2491	status = SnackOpenFile(ff->openProc, s, interp, &ch, "r");
2492      }
2493      if (status == TCL_OK) {
2494	if (obj == NULL) {
2495	  pos = SnackSeekFile(ff->seekProc, s, interp, ch, startpos);
2496	  if (pos < 0) {
2497	    SnackCloseFile(ff->closeProc, s, interp, &ch);
2498	    return NULL;
2499	  }
2500	}
2501      }
2502      if (status == TCL_OK && pos >= 0) {
2503	if (s->writeStatus == WRITE && s->encoding != oldsampfmt) {
2504	  Snack_StopSound(s, NULL);
2505	}
2506	status = ReadSound(ff->readProc, s, interp, ch, obj, startpos, endpos);
2507      }
2508      if (status == TCL_OK && obj == NULL) {
2509	status = SnackCloseFile(ff->closeProc, s, interp, &ch);
2510      }
2511      if (status == TCL_ERROR) {
2512	return NULL;
2513      }
2514      break;
2515    }
2516  }
2517
2518  if (s->debug > 1) Snack_WriteLog("  Exit LoadSound\n");
2519
2520  return(s->fileType);
2521}
2522
2523int
2524SaveSound(Sound *s, Tcl_Interp *interp, char *filename, Tcl_Obj *obj,
2525	  int objc, Tcl_Obj *CONST objv[], int startpos, int len, char *type)
2526{
2527  Tcl_Channel ch = NULL;
2528  Snack_FileFormat *ff;
2529  char *tmp = s->fcname;
2530
2531  if (s->debug > 1) Snack_WriteLog("  Enter SaveSound\n");
2532
2533  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
2534    if (strcmp(type, ff->name) == 0) {
2535      if (ff->putHeaderProc != NULL) {
2536	s->fcname = filename;
2537	if (filename != NULL) {
2538	  if (SnackOpenFile(ff->openProc, s, interp, &ch, "w") != TCL_OK) {
2539	    return TCL_ERROR;
2540	  }
2541	}
2542	if ((ff->putHeaderProc)(s, interp, ch, obj, objc, objv, len)
2543	    != TCL_OK) {
2544	  return TCL_ERROR;
2545	}
2546	if (WriteSound(ff->writeProc, s, interp, ch, obj, startpos,
2547		       len) != TCL_OK) {
2548	  Tcl_AppendResult(interp, "Error while writing", NULL);
2549	  s->fcname = tmp;
2550	  return TCL_ERROR;
2551	}
2552	s->fcname = tmp;
2553      } else {
2554	Tcl_AppendResult(interp, "Unsupported save format", NULL);
2555	return TCL_ERROR;
2556      }
2557      break;
2558    }
2559  }
2560
2561  if (ch != NULL) {
2562    SnackCloseFile(ff->closeProc, s, interp, &ch);
2563  }
2564
2565  if (s->debug > 1) Snack_WriteLog("  Exit SaveSound\n");
2566
2567  return TCL_OK;
2568}
2569
2570int
2571readCmd(Sound *s, Tcl_Interp *interp, int objc,	Tcl_Obj *CONST objv[])
2572{
2573  char *filetype;
2574  int arg, startpos = 0, endpos = -1;
2575  static CONST84 char *subOptionStrings[] = {
2576    "-rate", "-frequency", "-skiphead", "-byteorder", "-channels",
2577    "-encoding", "-format", "-start", "-end", "-fileformat",
2578    "-guessproperties", "-progress", NULL
2579  };
2580  enum subOptions {
2581    RATE, FREQUENCY, SKIPHEAD, BYTEORDER, CHANNELS, ENCODING, FORMAT,
2582    START, END, FILEFORMAT, GUESSPROPS, PROGRESS
2583  };
2584
2585  if (s->debug > 0) Snack_WriteLog("Enter readCmd\n");
2586
2587  if (objc < 3) {
2588    Tcl_AppendResult(interp, "No file name given", NULL);
2589    return TCL_ERROR;
2590  }
2591  if (s->storeType != SOUND_IN_MEMORY) {
2592    Tcl_AppendResult(interp, "read only works with in-memory sounds",
2593		     (char *) NULL);
2594    return TCL_ERROR;
2595  }
2596  if (Tcl_IsSafe(interp)) {
2597    Tcl_AppendResult(interp, "can not read sound from a file in a safe",
2598		     " interpreter", (char *) NULL);
2599    return TCL_ERROR;
2600  }
2601
2602  s->guessEncoding = -1;
2603  s->guessRate = -1;
2604  s->swap = 0;
2605  s->forceFormat = 0;
2606  if (s->cmdPtr != NULL) {
2607    Tcl_DecrRefCount(s->cmdPtr);
2608    s->cmdPtr = NULL;
2609  }
2610
2611  for (arg = 3; arg < objc; arg+=2) {
2612    int index;
2613
2614    if (Tcl_GetIndexFromObj(interp, objv[arg], subOptionStrings, "option",
2615			    0, &index) != TCL_OK) {
2616      return TCL_ERROR;
2617    }
2618
2619    if (arg + 1 == objc) {
2620      Tcl_AppendResult(interp, "No argument given for ",
2621		       subOptionStrings[index], " option", (char *) NULL);
2622      return TCL_ERROR;
2623    }
2624
2625    switch ((enum subOptions) index) {
2626    case RATE:
2627    case FREQUENCY:
2628      {
2629	if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->samprate) != TCL_OK)
2630	  return TCL_ERROR;
2631	s->guessRate = 0;
2632	break;
2633      }
2634    case SKIPHEAD:
2635      {
2636	if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->skipBytes) != TCL_OK)
2637	  return TCL_ERROR;
2638	break;
2639      }
2640    case BYTEORDER:
2641      {
2642	int length;
2643	char *str = Tcl_GetStringFromObj(objv[arg+1], &length);
2644
2645	if (strncasecmp(str, "littleEndian", length) == 0) {
2646	  SwapIfBE(s);
2647	} else if (strncasecmp(str, "bigEndian", length) == 0) {
2648	  SwapIfLE(s);
2649	} else {
2650	  Tcl_AppendResult(interp, "-byteorder option should be bigEndian",
2651			   " or littleEndian", NULL);
2652	  return TCL_ERROR;
2653	}
2654	s->guessEncoding = 0;
2655	break;
2656      }
2657    case CHANNELS:
2658      {
2659	if (GetChannels(interp, objv[arg+1], &s->nchannels) != TCL_OK)
2660	  return TCL_ERROR;
2661	break;
2662      }
2663    case ENCODING:
2664    case FORMAT:
2665      {
2666	if (GetEncoding(interp, objv[arg+1], &s->encoding, &s->sampsize) !=
2667	    TCL_OK)
2668	  return TCL_ERROR;
2669	s->guessEncoding = 0;
2670	break;
2671      }
2672    case START:
2673      {
2674	if (Tcl_GetIntFromObj(interp, objv[arg+1], &startpos) != TCL_OK)
2675	  return TCL_ERROR;
2676	break;
2677      }
2678    case END:
2679      {
2680	if (Tcl_GetIntFromObj(interp, objv[arg+1], &endpos) != TCL_OK)
2681	  return TCL_ERROR;
2682	break;
2683      }
2684    case FILEFORMAT:
2685      {
2686	if (strlen(Tcl_GetStringFromObj(objv[arg+1], NULL)) > 0) {
2687	  if (GetFileFormat(interp, objv[arg+1], &s->fileType) != TCL_OK) {
2688	    return TCL_ERROR;
2689	  }
2690	  s->forceFormat = 1;
2691	}
2692	break;
2693      }
2694    case GUESSPROPS:
2695      {
2696	int guessProps;
2697	if (Tcl_GetBooleanFromObj(interp, objv[arg+1], &guessProps) != TCL_OK)
2698	  return TCL_ERROR;
2699	if (guessProps) {
2700	  if (s->guessEncoding == -1) s->guessEncoding = 1;
2701	  if (s->guessRate == -1) s->guessRate = 1;
2702	}
2703	break;
2704      }
2705    case PROGRESS:
2706      {
2707	char *str = Tcl_GetStringFromObj(objv[arg+1], NULL);
2708
2709	if (strlen(str) > 0) {
2710	  Tcl_IncrRefCount(objv[arg+1]);
2711	  s->cmdPtr = objv[arg+1];
2712	}
2713	break;
2714      }
2715    }
2716  }
2717  if (s->guessEncoding == -1) s->guessEncoding = 0;
2718  if (s->guessRate == -1) s->guessRate = 0;
2719  if (startpos < 0) startpos = 0;
2720  if (startpos > endpos && endpos != -1) return TCL_OK;
2721  if (SetFcname(s, interp, objv[2]) != TCL_OK) {
2722    return TCL_ERROR;
2723  }
2724  if (strlen(s->fcname) == 0) {
2725    return TCL_OK;
2726  }
2727  filetype = LoadSound(s, interp, NULL, startpos, endpos);
2728
2729  if (filetype == NULL) {
2730    return TCL_ERROR;
2731  } else {
2732    Snack_UpdateExtremes(s, 0, s->length, SNACK_NEW_SOUND);
2733    Snack_ExecCallbacks(s, SNACK_NEW_SOUND);
2734    Tcl_SetObjResult(interp, Tcl_NewStringObj(filetype, -1));
2735  }
2736
2737  if (s->debug > 0) Snack_WriteLog("Exit readCmd\n");
2738
2739  return TCL_OK;
2740}
2741
2742void
2743Snack_RemoveOptions(int objc, Tcl_Obj *CONST objv[],
2744		    CONST84 char **subOptionStrings,
2745		    int *newobjc, Tcl_Obj **newobjv)
2746{
2747  int arg, n = 0;
2748  Tcl_Obj **new = NULL;
2749
2750  if ((new = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * objc)) == NULL) {
2751    return;
2752  }
2753  for (arg = 0; arg < objc; arg+=2) {
2754    int index;
2755
2756    if (Tcl_GetIndexFromObj(NULL, objv[arg], subOptionStrings,
2757			    NULL, 0, &index) != TCL_OK) {
2758      new[n++] = Tcl_DuplicateObj(objv[arg]);
2759      if (n < objc) new[n++] = Tcl_DuplicateObj(objv[arg+1]);
2760    }
2761  }
2762  *newobjc = n;
2763  *newobjv = (Tcl_Obj *) new;
2764}
2765
2766int
2767writeCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2768{
2769  int startpos = 0, endpos = s->length, arg, len, newobjc;
2770  char *string, *filetype = NULL;
2771  Tcl_Obj **newobjv = NULL;
2772  static CONST84 char *subOptionStrings[] = {
2773    "-start", "-end", "-fileformat", "-progress", "-byteorder", NULL
2774  };
2775  enum subOptions {
2776    START, END, FILEFORMAT, PROGRESS, BYTEORDER
2777  };
2778
2779  if (s->debug > 0) { Snack_WriteLog("Enter writeCmd\n"); }
2780
2781  if (Tcl_IsSafe(interp)) {
2782    Tcl_AppendResult(interp, "can not write sound to a file in a safe",
2783		     " interpreter", (char *) NULL);
2784    return TCL_ERROR;
2785  }
2786
2787  s->inByteOrder = SNACK_NATIVE;
2788  if (s->cmdPtr != NULL) {
2789    Tcl_DecrRefCount(s->cmdPtr);
2790    s->cmdPtr = NULL;
2791  }
2792
2793  for (arg = 3; arg < objc; arg+=2) {
2794    int index;
2795
2796    if (Tcl_GetIndexFromObj(NULL, objv[arg], subOptionStrings,
2797			    "option", 0, &index) != TCL_OK) {
2798      continue;
2799    }
2800
2801    if (arg + 1 == objc) {
2802      Tcl_AppendResult(interp, "No argument given for ",
2803		       subOptionStrings[index], " option", (char *) NULL);
2804      return TCL_ERROR;
2805    }
2806
2807    switch ((enum subOptions) index) {
2808    case START:
2809      {
2810	if (Tcl_GetIntFromObj(interp, objv[arg+1], &startpos) != TCL_OK)
2811	  return TCL_ERROR;
2812	break;
2813      }
2814    case END:
2815      {
2816	if (Tcl_GetIntFromObj(interp, objv[arg+1], &endpos) != TCL_OK)
2817	  return TCL_ERROR;
2818	break;
2819      }
2820    case FILEFORMAT:
2821      {
2822	if (GetFileFormat(interp, objv[arg+1], &filetype) != TCL_OK)
2823	  return TCL_ERROR;
2824	break;
2825      }
2826    case PROGRESS:
2827      {
2828	char *str = Tcl_GetStringFromObj(objv[arg+1], NULL);
2829
2830	if (strlen(str) > 0) {
2831	  Tcl_IncrRefCount(objv[arg+1]);
2832	  s->cmdPtr = objv[arg+1];
2833	}
2834	break;
2835      }
2836    case BYTEORDER:
2837      {
2838	int length;
2839	char *str = Tcl_GetStringFromObj(objv[arg+1], &length);
2840
2841	if (strncasecmp(str, "littleEndian", length) == 0) {
2842  	  s->inByteOrder = SNACK_LITTLEENDIAN;
2843	} else if (strncasecmp(str, "bigEndian", length) == 0) {
2844	  s->inByteOrder = SNACK_BIGENDIAN;
2845	} else {
2846	  Tcl_AppendResult(interp, "-byteorder option should be bigEndian",
2847			   " or littleEndian", NULL);
2848	  return TCL_ERROR;
2849	}
2850	break;
2851      }
2852    }
2853  }
2854  len = s->length;
2855  if (endpos >= len) endpos = len;
2856  if (endpos < 0)    endpos = len;
2857  if (endpos > startpos) len -= (len - endpos);
2858  if (startpos > endpos) return TCL_OK;
2859  if (startpos > 0) len -= startpos; else startpos = 0;
2860
2861  Snack_RemoveOptions(objc-3, objv+3, subOptionStrings, &newobjc,
2862		      (Tcl_Obj **) &newobjv);
2863
2864  if (objc < 3) {
2865    Tcl_AppendResult(interp, "No file name given", NULL);
2866    return TCL_ERROR;
2867  }
2868  string = Tcl_GetStringFromObj(objv[2], NULL);
2869  if (filetype == NULL) {
2870    filetype = NameGuessFileType(string);
2871  }
2872  if (strlen(string) == 0) {
2873    return TCL_OK;
2874  }
2875  if (s->storeType != SOUND_IN_MEMORY) {
2876    if (s->linkInfo.linkCh == NULL) {
2877      OpenLinkedFile(s, &s->linkInfo);
2878    }
2879  }
2880  if (SaveSound(s, interp, string, NULL, newobjc, (Tcl_Obj **CONST) newobjv,
2881		startpos, len, filetype) == TCL_ERROR) {
2882    return TCL_ERROR;
2883  }
2884
2885
2886  for (arg = 0; arg <newobjc; arg++) {
2887    Tcl_DecrRefCount(newobjv[arg]);
2888  }
2889  ckfree((char *)newobjv);
2890
2891  if (s->debug > 0) { Snack_WriteLog("Exit writeCmd\n"); }
2892
2893  return TCL_OK;
2894} /* writeCmd */
2895
2896int
2897dataCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2898{
2899  if (s->storeType != SOUND_IN_MEMORY) {
2900    Tcl_AppendResult(interp, "data only works with in-memory sounds",
2901		     (char *) NULL);
2902    return TCL_ERROR;
2903  }
2904
2905  if ((objc % 2) == 0) { /* sound -> variable */
2906    Tcl_Obj *new = Tcl_NewObj();
2907    char *filetype = s->fileType;
2908    int arg, len, startpos = 0, endpos = s->length;
2909    static CONST84 char *subOptionStrings[] = {
2910      "-fileformat", "-start", "-end", "-byteorder",
2911      NULL
2912    };
2913    enum subOptions {
2914      FILEFORMAT, START, END, BYTEORDER
2915    };
2916
2917    s->swap = 0;
2918
2919    for (arg = 2; arg < objc; arg += 2) {
2920      int index;
2921      char *str;
2922
2923      if (Tcl_GetIndexFromObj(interp, objv[arg], subOptionStrings,
2924			      "option", 0, &index) != TCL_OK) {
2925	return TCL_ERROR;
2926      }
2927
2928      if (arg + 1 == objc) {
2929	Tcl_AppendResult(interp, "No argument given for ",
2930			 subOptionStrings[index], " option", (char *) NULL);
2931	return TCL_ERROR;
2932      }
2933
2934      switch ((enum subOptions) index) {
2935      case FILEFORMAT:
2936	{
2937	  if (GetFileFormat(interp, objv[arg+1], &filetype) != TCL_OK)
2938	    return TCL_ERROR;
2939	  break;
2940
2941	}
2942      case START:
2943	{
2944	  if (Tcl_GetIntFromObj(interp, objv[arg+1], &startpos) != TCL_OK)
2945	    return TCL_ERROR;
2946	  break;
2947	}
2948      case END:
2949	{
2950	  if (Tcl_GetIntFromObj(interp, objv[arg+1], &endpos) != TCL_OK)
2951	    return TCL_ERROR;
2952	  break;
2953	}
2954      case BYTEORDER:
2955	{
2956	  str = Tcl_GetStringFromObj(objv[arg+1], &len);
2957	  if (strncasecmp(str, "littleEndian", len) == 0) {
2958	    SwapIfBE(s);
2959	  } else if (strncasecmp(str, "bigEndian", len) == 0) {
2960	    SwapIfLE(s);
2961	  } else {
2962	    Tcl_AppendResult(interp,
2963	       "-byteorder option should be bigEndian or littleEndian", NULL);
2964	    return TCL_ERROR;
2965	  }
2966	  break;
2967	}
2968      }
2969    }
2970
2971    len = s->length;
2972    if (endpos >= len) endpos = len;
2973    if (endpos < 0)    endpos = len;
2974    if (endpos > startpos) len -= (len - endpos);
2975    if (startpos > endpos) return TCL_OK;
2976    if (startpos > 0) len -= startpos; else startpos = 0;
2977
2978    if (SaveSound(s, interp, NULL, new, objc-2, objv+2, startpos, len,filetype)
2979	== TCL_ERROR) {
2980      return TCL_ERROR;
2981    }
2982    Tcl_SetObjResult(interp, new);
2983  } else { /* variable -> sound */
2984    int arg, startpos = 0, endpos = -1;
2985    char *filetype;
2986    static CONST84 char *subOptionStrings[] = {
2987      "-rate", "-frequency", "-skiphead", "-byteorder",
2988      "-channels", "-encoding", "-format", "-start", "-end", "-fileformat",
2989      "-guessproperties", NULL
2990    };
2991    enum subOptions {
2992      RATE, FREQUENCY, SKIPHEAD, BYTEORDER, CHANNELS, ENCODING, FORMAT,
2993      START, END, FILEFORMAT, GUESSPROPS
2994    };
2995
2996    s->guessEncoding = -1;
2997    s->guessRate = -1;
2998    s->swap = 0;
2999    s->forceFormat = 0;
3000
3001    for (arg = 3; arg < objc; arg += 2) {
3002      int index;
3003
3004      if (Tcl_GetIndexFromObj(interp, objv[arg], subOptionStrings,
3005			      "option", 0, &index) != TCL_OK) {
3006	return TCL_ERROR;
3007      }
3008
3009      if (arg + 1 == objc) {
3010	Tcl_AppendResult(interp, "No argument given for ",
3011			 subOptionStrings[index], " option", (char *) NULL);
3012	return TCL_ERROR;
3013      }
3014
3015      switch ((enum subOptions) index) {
3016      case RATE:
3017      case FREQUENCY:
3018	{
3019	  if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->samprate) != TCL_OK)
3020	    return TCL_ERROR;
3021	  s->guessRate = 0;
3022	  break;
3023	}
3024      case SKIPHEAD:
3025	{
3026	  if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->skipBytes) != TCL_OK) {
3027	    return TCL_ERROR;
3028	  }
3029	  break;
3030	}
3031      case BYTEORDER:
3032	{
3033	  int length;
3034	  char *str = Tcl_GetStringFromObj(objv[arg+1], &length);
3035
3036	  if (strncasecmp(str, "littleEndian", length) == 0) {
3037	    SwapIfBE(s);
3038	  } else if (strncasecmp(str, "bigEndian", length) == 0) {
3039	    SwapIfLE(s);
3040	  } else {
3041	    Tcl_AppendResult(interp, "-byteorder option should be bigEndian",
3042			     " or littleEndian", NULL);
3043	    return TCL_ERROR;
3044	  }
3045	  s->guessEncoding = 0;
3046	  break;
3047	}
3048      case CHANNELS:
3049	{
3050	  if (GetChannels(interp, objv[arg+1], &s->nchannels) != TCL_OK)
3051	    return TCL_ERROR;
3052	  break;
3053	}
3054      case ENCODING:
3055      case FORMAT:
3056	{
3057	  if (GetEncoding(interp, objv[arg+1], &s->encoding, &s->sampsize)
3058	      != TCL_OK)
3059	    return TCL_ERROR;
3060	  s->guessEncoding = 0;
3061	  break;
3062	}
3063      case START:
3064	{
3065	  if (Tcl_GetIntFromObj(interp, objv[arg+1], &startpos) != TCL_OK)
3066	    return TCL_ERROR;
3067	  break;
3068	}
3069      case END:
3070	{
3071	  if (Tcl_GetIntFromObj(interp, objv[arg+1], &endpos) != TCL_OK)
3072	    return TCL_ERROR;
3073	  break;
3074	}
3075      case FILEFORMAT:
3076	{
3077	  if (strlen(Tcl_GetStringFromObj(objv[arg+1], NULL)) > 0) {
3078	    if (GetFileFormat(interp, objv[arg+1], &s->fileType) != TCL_OK)
3079	      return TCL_ERROR;
3080	    s->forceFormat = 1;
3081	    break;
3082	  }
3083	}
3084      case GUESSPROPS:
3085	{
3086	  int guessProps;
3087	  if (Tcl_GetBooleanFromObj(interp, objv[arg+1], &guessProps) !=TCL_OK)
3088	    return TCL_ERROR;
3089	  if (guessProps) {
3090	    if (s->guessEncoding == -1) s->guessEncoding = 1;
3091	    if (s->guessRate == -1) s->guessRate = 1;
3092	  }
3093	  break;
3094	}
3095      }
3096    }
3097    if (s->guessEncoding == -1) s->guessEncoding = 0;
3098    if (s->guessRate == -1) s->guessRate = 0;
3099    if (startpos < 0) startpos = 0;
3100    if (startpos > endpos && endpos != -1) return TCL_OK;
3101    filetype = LoadSound(s, interp, objv[2], startpos, endpos);
3102    if (filetype == NULL) {
3103      return TCL_ERROR;
3104    } else {
3105      Snack_UpdateExtremes(s, 0, s->length, SNACK_NEW_SOUND);
3106      Snack_ExecCallbacks(s, SNACK_NEW_SOUND);
3107      Tcl_SetObjResult(interp, Tcl_NewStringObj(filetype, -1));
3108    }
3109  }
3110
3111  return TCL_OK;
3112} /* dataCmd */
3113
3114int
3115GetHeader(Sound *s, Tcl_Interp *interp, Tcl_Obj *obj)
3116{
3117  Snack_FileFormat *ff;
3118  Tcl_Channel ch = NULL;
3119  int status = TCL_OK, openedOk = 0;
3120  int buflen = max(HEADBUF, CHANNEL_HEADER_BUFFER), len = 0;
3121
3122  if (s->guessEncoding) {
3123    s->swap = 0;
3124  }
3125  if (s->tmpbuf != NULL) {
3126    ckfree((char *)s->tmpbuf);
3127  }
3128  if ((s->tmpbuf = (short *) ckalloc(buflen)) == NULL) {
3129    Tcl_AppendResult(interp, "Could not allocate buffer!", NULL);
3130    return TCL_ERROR;
3131  }
3132  if (obj == NULL) {
3133    ch = Tcl_OpenFileChannel(interp, s->fcname, "r", 0);
3134    if (ch != NULL) {
3135      Tcl_SetChannelOption(interp, ch, "-translation", "binary");
3136#ifdef TCL_81_API
3137      Tcl_SetChannelOption(interp, ch, "-encoding", "binary");
3138#endif
3139      if ((len = Tcl_Read(ch, (char *)s->tmpbuf, buflen)) > 0) {
3140	Tcl_Close(interp, ch);
3141	ch = NULL;
3142      }
3143    } else {
3144      ckfree((char *)s->tmpbuf);
3145      s->tmpbuf = NULL;
3146      return TCL_ERROR;
3147    }
3148  } else {
3149    unsigned char *ptr = NULL;
3150
3151    if (useOldObjAPI) {
3152      len = min(obj->length, buflen);
3153      memcpy((char *)s->tmpbuf, obj->bytes, len);
3154    } else {
3155#ifdef TCL_81_API
3156      int length = 0;
3157
3158      ptr = Tcl_GetByteArrayFromObj(obj, &length);
3159      len = min(length, buflen);
3160      memcpy((char *)s->tmpbuf, ptr, len);
3161#endif
3162    }
3163  }
3164  if (s->forceFormat == 0) {
3165    s->fileType = GuessFileType((char *)s->tmpbuf, len, 1);
3166  }
3167  s->firstNRead = len;
3168
3169  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
3170    if (strcmp(s->fileType, ff->name) == 0) {
3171      if (obj == NULL) {
3172	status = SnackOpenFile(ff->openProc, s, interp, &ch, "r");
3173	if (status == TCL_OK) openedOk = 1;
3174      }
3175      if (status == TCL_OK) {
3176	status = (ff->getHeaderProc)(s, interp, ch, obj, (char *)s->tmpbuf);
3177      }
3178      if (strcmp(s->fileType, RAW_STRING) == 0 && s->guessEncoding) {
3179	GuessEncoding(s, (unsigned char *)s->tmpbuf, len);
3180      }
3181      if (obj == NULL && openedOk == 1) {
3182	status = SnackCloseFile(ff->closeProc, s, interp, &ch);
3183      }
3184      ckfree((char *)s->tmpbuf);
3185      s->tmpbuf = NULL;
3186
3187      return(status);
3188    }
3189  }
3190  ckfree((char *)s->tmpbuf);
3191  s->tmpbuf = NULL;
3192
3193  return TCL_OK;
3194}
3195
3196int
3197PutHeader(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[],
3198	  int length)
3199{
3200  Snack_FileFormat *ff;
3201
3202  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
3203    if (strcmp(s->fileType, ff->name) == 0) {
3204      if (ff->putHeaderProc != NULL) {
3205	return (ff->putHeaderProc)(s, interp, s->rwchan, NULL, objc, objv,
3206				   length);
3207      }
3208      break;
3209    }
3210  }
3211  return 0;
3212}
3213
3214int
3215GetFileFormat(Tcl_Interp *interp, Tcl_Obj *obj, char **filetype)
3216{
3217  int length;
3218  char *str = Tcl_GetStringFromObj(obj, &length);
3219  Snack_FileFormat *ff;
3220
3221  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
3222    if (strcasecmp(str, ff->name) == 0) {
3223      *filetype = ff->name;
3224      return TCL_OK;
3225    }
3226  }
3227
3228  if (strcasecmp(str, RAW_STRING) == 0) {
3229    *filetype = RAW_STRING;
3230    return TCL_OK;
3231  }
3232
3233  Tcl_AppendResult(interp, "Unknown file format", NULL);
3234
3235  return TCL_ERROR;
3236}
3237
3238void
3239Snack_CreateFileFormat(Snack_FileFormat *typePtr)
3240{
3241  Snack_FileFormat *typePtr2, *prevPtr;
3242
3243  /*
3244   * If there's already a filter type with the given name, remove it.
3245   */
3246
3247  for (typePtr2 = snackFileFormats, prevPtr = NULL; typePtr2 != NULL;
3248       prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
3249    if (strcmp(typePtr2->name, typePtr->name) == 0) {
3250      if (prevPtr == NULL) {
3251	snackFileFormats = typePtr2->nextPtr;
3252      } else {
3253	prevPtr->nextPtr = typePtr2->nextPtr;
3254      }
3255      break;
3256    }
3257  }
3258  typePtr->nextPtr = snackFileFormats;
3259  snackFileFormats = typePtr;
3260}
3261
3262/* Deprecated, use Snack_CreateFileFormat() instead */
3263
3264int
3265Snack_AddFileFormat(char *name, guessFileTypeProc *guessProc,
3266		    getHeaderProc *getHeadProc, extensionFileTypeProc *extProc,
3267		    putHeaderProc *putHeadProc, openProc *openProc,
3268		    closeProc *closeProc, readSamplesProc *readProc,
3269		    writeSamplesProc *writeProc, seekProc *seekProc)
3270{
3271  Snack_FileFormat *ff = (Snack_FileFormat *)ckalloc(sizeof(Snack_FileFormat));
3272
3273  if (ff == NULL) {
3274    return TCL_ERROR;
3275  }
3276  ff->name          = name;
3277  ff->guessProc     = guessProc;
3278  ff->getHeaderProc = getHeadProc;
3279  ff->extProc       = extProc;
3280  ff->putHeaderProc = putHeadProc;
3281  ff->openProc      = openProc;
3282  ff->closeProc     = closeProc;
3283  ff->readProc      = readProc;
3284  ff->writeProc     = writeProc;
3285  ff->seekProc      = seekProc;
3286  ff->nextPtr       = snackFileFormats;
3287  snackFileFormats  = ff;
3288
3289  return TCL_OK;
3290}
3291
3292Snack_FileFormat snackRawFormat = {
3293  RAW_STRING,
3294  GuessRawFile,
3295  GetRawHeader,
3296  NULL,
3297  PutRawHeader,
3298  NULL,
3299  NULL,
3300  NULL,
3301  NULL,
3302  NULL,
3303  NULL,
3304  NULL,
3305  (Snack_FileFormat *) NULL
3306};
3307
3308Snack_FileFormat snackMp3Format = {
3309  MP3_STRING,
3310  GuessMP3File,
3311  GetMP3Header,
3312  ExtMP3File,
3313  NULL,
3314  OpenMP3File,
3315  CloseMP3File,
3316  ReadMP3Samples,
3317  NULL,
3318  SeekMP3File,
3319  FreeMP3Header,
3320  ConfigMP3Header,
3321  (Snack_FileFormat *) NULL
3322};
3323
3324Snack_FileFormat snackSmpFormat = {
3325  SMP_STRING,
3326  GuessSmpFile,
3327  GetSmpHeader,
3328  ExtSmpFile,
3329  PutSmpHeader,
3330  NULL,
3331  NULL,
3332  NULL,
3333  NULL,
3334  NULL,
3335  NULL,
3336  NULL,
3337  (Snack_FileFormat *) NULL
3338};
3339
3340Snack_FileFormat snackCslFormat = {
3341  CSL_STRING,
3342  GuessCslFile,
3343  GetCslHeader,
3344  ExtCslFile,
3345  PutCslHeader,
3346  NULL,
3347  NULL,
3348  NULL,
3349  NULL,
3350  NULL,
3351  NULL,
3352  NULL,
3353  (Snack_FileFormat *) NULL
3354};
3355
3356Snack_FileFormat snackSdFormat = {
3357  SD_STRING,
3358  GuessSdFile,
3359  GetSdHeader,
3360  ExtSdFile,
3361  NULL,
3362  NULL,
3363  NULL,
3364  NULL,
3365  NULL,
3366  NULL,
3367  FreeSdHeader,
3368  ConfigSdHeader,
3369  (Snack_FileFormat *) NULL
3370};
3371
3372Snack_FileFormat snackAiffFormat = {
3373  AIFF_STRING,
3374  GuessAiffFile,
3375  GetAiffHeader,
3376  ExtAiffFile,
3377  PutAiffHeader,
3378  NULL,
3379  NULL,
3380  NULL,
3381  NULL,
3382  NULL,
3383  NULL,
3384  NULL,
3385  (Snack_FileFormat *) NULL
3386};
3387
3388Snack_FileFormat snackAuFormat = {
3389  AU_STRING,
3390  GuessAuFile,
3391  GetAuHeader,
3392  ExtAuFile,
3393  PutAuHeader,
3394  NULL,
3395  NULL,
3396  NULL,
3397  NULL,
3398  NULL,
3399  NULL,
3400  NULL,
3401  (Snack_FileFormat *) NULL
3402};
3403
3404Snack_FileFormat snackWavFormat = {
3405  WAV_STRING,
3406  GuessWavFile,
3407  GetWavHeader,
3408  ExtWavFile,
3409  PutWavHeader,
3410  NULL,
3411  NULL,
3412  NULL,
3413  NULL,
3414  NULL,
3415  NULL,
3416  NULL,
3417  (Snack_FileFormat *) NULL
3418};
3419
3420void
3421SnackDefineFileFormats(Tcl_Interp *interp)
3422/*
3423{
3424  snackFileFormats        = &snackWavFormat;
3425  snackWavFormat.nextPtr  = &snackAiffFormat;
3426  snackAiffFormat.nextPtr = &snackAuFormat;
3427  snackAuFormat.nextPtr   = &snackSmpFormat;
3428  snackSmpFormat.nextPtr  = &snackCslFormat;
3429  snackCslFormat.nextPtr  = &snackSdFormat;
3430  snackSdFormat.nextPtr   = &snackMp3Format;
3431  snackMp3Format.nextPtr  = &snackRawFormat;
3432  snackRawFormat.nextPtr  = NULL;
3433}
3434*/
3435{
3436  snackFileFormats        = &snackWavFormat;
3437  snackWavFormat.nextPtr  = &snackMp3Format;
3438  snackMp3Format.nextPtr  = &snackAiffFormat;
3439  snackAiffFormat.nextPtr = &snackAuFormat;
3440  snackAuFormat.nextPtr   = &snackSmpFormat;
3441  snackSmpFormat.nextPtr  = &snackCslFormat;
3442  snackCslFormat.nextPtr  = &snackSdFormat;
3443  snackSdFormat.nextPtr   = &snackRawFormat;
3444  snackRawFormat.nextPtr  = NULL;
3445}
3446
3447#define BACKLOGSAMPS 1
3448
3449int
3450OpenLinkedFile(Sound *s, SnackLinkedFileInfo *infoPtr)
3451{
3452  Snack_FileFormat *ff;
3453
3454  infoPtr->sound = s;
3455
3456  if (strlen(s->fcname) == 0) {
3457    return TCL_OK;
3458  }
3459  if (s->itemRefCnt && s->readStatus == READ) {
3460    return TCL_OK;
3461  }
3462
3463  infoPtr->buffer = (float *) ckalloc(ITEMBUFFERSIZE);
3464  infoPtr->filePos = -1;
3465  infoPtr->validSamples = 0;
3466  infoPtr->eof = 0;
3467
3468  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
3469    if (strcmp(s->fileType, ff->name) == 0) {
3470      if (SnackOpenFile(ff->openProc, s, s->interp, &infoPtr->linkCh, "r")
3471	  != TCL_OK) {
3472	return TCL_ERROR;
3473      }
3474      return TCL_OK;
3475    }
3476  }
3477  return TCL_ERROR;
3478}
3479
3480void
3481CloseLinkedFile(SnackLinkedFileInfo *infoPtr)
3482{
3483  Sound *s = infoPtr->sound;
3484  Snack_FileFormat *ff;
3485
3486  if (strlen(s->fcname) == 0) {
3487    return;
3488  }
3489  if (s->itemRefCnt && s->readStatus == READ) {
3490    return;
3491  }
3492
3493  ckfree((char *) infoPtr->buffer);
3494
3495  for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
3496    if (strcmp(s->fileType, ff->name) == 0) {
3497      SnackCloseFile(ff->closeProc, s, s->interp, &infoPtr->linkCh);
3498      return;
3499    }
3500  }
3501}
3502
3503float junkBuffer[PBSIZE];
3504
3505float
3506GetSample(SnackLinkedFileInfo *infoPtr, int index)
3507{
3508  Sound *s = infoPtr->sound;
3509  Snack_FileFormat *ff;
3510  int nRead = 0, size = ITEMBUFFERSIZE / sizeof(float), i;
3511
3512  if (s->itemRefCnt && s->readStatus == READ) {
3513    return FSAMPLE(s, index);
3514  }
3515
3516  if (index < infoPtr->filePos + ITEMBUFFERSIZE / (int) sizeof(float)
3517      && index >= infoPtr->filePos && infoPtr->filePos != -1) {
3518    if (index < infoPtr->filePos + infoPtr->validSamples) {
3519      return(infoPtr->buffer[index-infoPtr->filePos]);
3520    } else {
3521      infoPtr->eof = 1;
3522      return(0.0f);
3523    }
3524  } else {
3525    int pos = 0, doSeek = 1;
3526
3527    if (index == infoPtr->filePos + ITEMBUFFERSIZE / (int) sizeof(float)) {
3528      doSeek = 0;
3529    }
3530
3531    /* Keep BACKLOGSAMPS old samples in the buffer */
3532
3533    if (index > BACKLOGSAMPS * s->nchannels) {
3534      index -= BACKLOGSAMPS * s->nchannels;
3535    }
3536
3537    for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
3538      if (strcmp(s->fileType, ff->name) == 0) {
3539	char *b = &((char *)infoPtr->buffer)[ITEMBUFFERSIZE  - size * s->sampsize];
3540
3541	if (doSeek || ff->readProc == NULL) {
3542	  SnackSeekFile(ff->seekProc, s, s->interp, infoPtr->linkCh, index /
3543			s->nchannels);
3544	}
3545	if (s->nchannels > 1 && index % s->nchannels > 0) {
3546	  pos   = index % s->nchannels + s->nchannels;
3547	  index = s->nchannels * (int)(index / s->nchannels);
3548	} else {
3549	  if (index > 0) {
3550	    pos = s->nchannels;
3551	  }
3552	}
3553
3554	if (ff->readProc == NULL) {
3555	  nRead = Tcl_Read(infoPtr->linkCh, b, size * s->sampsize);
3556	  infoPtr->validSamples = nRead / s->sampsize;
3557	} else {
3558	  int tries=10,maxt=tries;
3559	  /* TFW: Workaround for streaming issues:
3560	   * Make sure we get something from the channel if possible
3561	   * on some (e.g. ogg) streams, we sometime get a -1 back for length
3562	   * typically on the second retry we get it right.
3563           */
3564	  for (;tries>0;tries--) {
3565	    nRead = (ff->readProc)(s, s->interp, infoPtr->linkCh, NULL,
3566				   junkBuffer, size);
3567	    if (nRead > 0) break;
3568	  }
3569	  if (s->debug > 1 && tries < maxt) {
3570	    Snack_WriteLogInt("  Read Tries", maxt-tries);
3571	    Snack_WriteLogInt("  Read Samples", nRead);
3572	  }
3573	  infoPtr->validSamples = nRead;
3574	  memcpy(infoPtr->buffer, junkBuffer, nRead * sizeof(float));
3575	}
3576
3577	if (ff->readProc == NULL) { /* unpack block */
3578	  unsigned char *q = (unsigned char *) b;
3579	  char *sc = (char *) b;
3580	  short *r = (short *) b;
3581	  int   *is = (int *) b;
3582	  float *fs = (float *) b;
3583	  float *f = infoPtr->buffer;
3584
3585	  for (i = 0; i < size; i++) {
3586	    switch (s->encoding) {
3587	    case LIN16:
3588	      if (s->swap) *r = Snack_SwapShort(*r);
3589	      *f++ = (float) *r++;
3590	      break;
3591	    case LIN32:
3592	      if (s->swap) *is = Snack_SwapLong(*is);
3593	      *f++ = (float) *is++;
3594	      break;
3595	    case SNACK_FLOAT:
3596	      if (s->swap) *fs = (float) Snack_SwapLong((int)*fs);
3597	      *f++  = (float) *fs++;
3598	      break;
3599	    case ALAW:
3600	      *f++ = (float) Snack_Alaw2Lin(*q++);
3601	      break;
3602	    case MULAW:
3603	      *f++ = (float) Snack_Mulaw2Lin(*q++);
3604	      break;
3605	    case LIN8:
3606	      *f++ = (float) *sc++;
3607	      break;
3608	    case LIN8OFFSET:
3609	      *f++ = (float) *q++;
3610	      break;
3611	    case LIN24:
3612	    case LIN24PACKED:
3613	      {
3614		int ee;
3615		if (s->swap) {
3616		  if (littleEndian) {
3617		    ee = 0;
3618		  } else {
3619		    ee = 1;
3620		  }
3621		} else {
3622		  if (littleEndian) {
3623		    ee = 1;
3624		  } else {
3625		    ee = 0;
3626		  }
3627		}
3628		if (ee) {
3629		  int t = *q++;
3630		  t |= *q++ << 8;
3631		  t |= *q++ << 16;
3632		  if (t & 0x00800000) {
3633		    t |= (unsigned int) 0xff000000;
3634		  }
3635		  *f++ = (float) t;
3636		} else {
3637		  int t = *q++ << 16;
3638		  t |= *q++ << 8;
3639		  t |= *q++;
3640		  if (t & 0x00800000) {
3641		    t |= (unsigned int) 0xff000000;
3642		  }
3643		  *f++ = (float) t;
3644		}
3645		break;
3646	      }
3647	    }
3648	  }
3649	}
3650	break;
3651      }
3652    }
3653    infoPtr->filePos = index;
3654
3655    return(infoPtr->buffer[pos]);
3656  }
3657}
3658
3659Snack_FileFormat *
3660Snack_GetFileFormats()
3661{
3662  return snackFileFormats;
3663}
3664