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 
27 extern int littleEndian;
28 
29 struct Snack_FileFormat *snackFileFormats = NULL;
30 
31 extern int useOldObjAPI;
32 
33 static char *
GuessWavFile(char * buf,int len)34 GuessWavFile(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 
48 static char *
GuessAuFile(char * buf,int len)49 GuessAuFile(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 
58 static char *
GuessAiffFile(char * buf,int len)59 GuessAiffFile(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 
70 static char *
GuessSmpFile(char * buf,int len)71 GuessSmpFile(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 
84 static char *
GuessSdFile(char * buf,int len)85 GuessSdFile(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 
94 static char *
GuessCslFile(char * buf,int len)95 GuessCslFile(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 
104 static char *
GuessRawFile(char * buf,int len)105 GuessRawFile(char *buf, int len)
106 {
107   return(RAW_STRING);
108 }
109 
110 char *
GuessFileType(char * buf,int len,int eof)111 GuessFileType(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 
139 static int
ExtCmp(char * s1,char * s2)140 ExtCmp(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 
148 static char *
ExtSmpFile(char * s)149 ExtSmpFile(char *s)
150 {
151   if (ExtCmp(".smp", s) == 0) {
152     return(SMP_STRING);
153   }
154   return(NULL);
155 }
156 
157 static char *
ExtWavFile(char * s)158 ExtWavFile(char *s)
159 {
160   if (ExtCmp(".wav", s) == 0) {
161     return(WAV_STRING);
162   }
163   return(NULL);
164 }
165 
166 static char *
ExtAuFile(char * s)167 ExtAuFile(char *s)
168 {
169   if (ExtCmp(".au", s) == 0 || ExtCmp(".snd", s) == 0) {
170     return(AU_STRING);
171   }
172   return(NULL);
173 }
174 
175 static char *
ExtAiffFile(char * s)176 ExtAiffFile(char *s)
177 {
178   if (ExtCmp(".aif", s) == 0 || ExtCmp(".aiff", s) == 0) {
179     return(AIFF_STRING);
180   }
181   return(NULL);
182 }
183 
184 static char *
ExtSdFile(char * s)185 ExtSdFile(char *s)
186 {
187   if (ExtCmp(".sd", s) == 0) {
188     return(SD_STRING);
189   }
190   return(NULL);
191 }
192 
193 static char *
ExtCslFile(char * s)194 ExtCslFile(char *s)
195 {
196   if (ExtCmp(".nsp", s) == 0) {
197     return(CSL_STRING);
198   }
199   return(NULL);
200 }
201 
202 char *
NameGuessFileType(char * s)203 NameGuessFileType(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 /*
218 static short
219 ReadBEShort(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 
232 static short
233 ReadLEShort(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 
246 static int32_t
247 ReadBELong(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 
260 static int32_t
261 ReadLELong(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 */
274 static int
WriteLEShort(Tcl_Channel ch,short s)275 WriteLEShort(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 
286 int
WriteLELong(Tcl_Channel ch,int32_t l)287 WriteLELong(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 
298 static int
WriteBEShort(Tcl_Channel ch,short s)299 WriteBEShort(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 
310 int
WriteBELong(Tcl_Channel ch,int32_t l)311 WriteBELong(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 
322 static int32_t
GetLELong(char * buf,int pos)323 GetLELong(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 
336 static short
GetLEShort(char * buf,int pos)337 GetLEShort(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 
354 static int32_t
GetBELong(char * buf,int pos)355 GetBELong(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 
368 static short
GetBEShort(char * buf,int pos)369 GetBEShort(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 
386 static void
PutBELong(char * buf,int pos,int32_t l)387 PutBELong(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 
398 static void
PutBEShort(char * buf,int pos,short s)399 PutBEShort(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 
417 static void
PutLELong(char * buf,int pos,int32_t l)418 PutLELong(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 
434 static void
PutLEShort(char * buf,int pos,short s)435 PutLEShort(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 
451 extern short shortBuffer[];
452 extern float floatBuffer[];
453 
454 static int
ReadSound(readSamplesProc * readProc,Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int startpos,int endpos)455 ReadSound(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 
736 int
WriteSound(writeSamplesProc * writeProc,Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int startpos,int len)737 WriteSound(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 
1089 typedef 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 
1103 int
GuessEncoding(Sound * s,unsigned char * buf,int len)1104 GuessEncoding(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 
1310 static int
GetRawHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,char * buf)1311 GetRawHeader(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 
1337 static int
PutRawHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int objc,Tcl_Obj * CONST objv[],int len)1338 PutRawHeader(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 
1348 static int
GetSmpHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,char * buf)1349 GetSmpHeader(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 
1424 static int
PutSmpHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int objc,Tcl_Obj * CONST objv[],int len)1425 PutSmpHeader(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 
1473 static int
GetSdHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,char * buf)1474 GetSdHeader(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 
1565 static int
ConfigSdHeader(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1566 ConfigSdHeader(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 
1599 static void
FreeSdHeader(Sound * s)1600 FreeSdHeader(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 
1624 static int
GetAuHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,char * buf)1625 GetAuHeader(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 
1715 static int
PutAuHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int objc,Tcl_Obj * CONST objv[],int len)1716 PutAuHeader(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 
1795 static int
GetHeaderBytes(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,char * buf,int len)1796 GetHeaderBytes(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 
1810 static int
GetWavHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,char * buf)1811 GetWavHeader(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 
1961 static int
PutWavHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int objc,Tcl_Obj * CONST objv[],int len)1962 PutWavHeader(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 
2026 static uint32_t
ConvertFloat(unsigned char * buffer)2027 ConvertFloat(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 
2046 static void
StoreFloat(unsigned char * buffer,uint32_t value)2047 StoreFloat(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 
2077 static int
GetAiffHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,char * buf)2078 GetAiffHeader(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 
2168 int
PutAiffHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int objc,Tcl_Obj * CONST objv[],int len)2169 PutAiffHeader(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 
2223 static int
GetCslHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,char * buf)2224 GetCslHeader(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 
2353 static int
PutCslHeader(Sound * s,Tcl_Interp * interp,Tcl_Channel ch,Tcl_Obj * obj,int objc,Tcl_Obj * CONST objv[],int len)2354 PutCslHeader(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 
2421 int
SnackOpenFile(openProc * openProc,Sound * s,Tcl_Interp * interp,Tcl_Channel * ch,char * mode)2422 SnackOpenFile(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 
2447 int
SnackCloseFile(closeProc * closeProc,Sound * s,Tcl_Interp * interp,Tcl_Channel * ch)2448 SnackCloseFile(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 
2461 int
SnackSeekFile(seekProc * seekProc,Sound * s,Tcl_Interp * interp,Tcl_Channel ch,int pos)2462 SnackSeekFile(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 
2473 char *
LoadSound(Sound * s,Tcl_Interp * interp,Tcl_Obj * obj,int startpos,int endpos)2474 LoadSound(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 
2523 int
SaveSound(Sound * s,Tcl_Interp * interp,char * filename,Tcl_Obj * obj,int objc,Tcl_Obj * CONST objv[],int startpos,int len,char * type)2524 SaveSound(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 
2570 int
readCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2571 readCmd(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 
2742 void
Snack_RemoveOptions(int objc,Tcl_Obj * CONST objv[],CONST84 char ** subOptionStrings,int * newobjc,Tcl_Obj ** newobjv)2743 Snack_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 
2766 int
writeCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2767 writeCmd(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 
2896 int
dataCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2897 dataCmd(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 
3114 int
GetHeader(Sound * s,Tcl_Interp * interp,Tcl_Obj * obj)3115 GetHeader(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 
3196 int
PutHeader(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[],int length)3197 PutHeader(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 
3214 int
GetFileFormat(Tcl_Interp * interp,Tcl_Obj * obj,char ** filetype)3215 GetFileFormat(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 
3238 void
Snack_CreateFileFormat(Snack_FileFormat * typePtr)3239 Snack_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 
3264 int
Snack_AddFileFormat(char * name,guessFileTypeProc * guessProc,getHeaderProc * getHeadProc,extensionFileTypeProc * extProc,putHeaderProc * putHeadProc,openProc * openProc,closeProc * closeProc,readSamplesProc * readProc,writeSamplesProc * writeProc,seekProc * seekProc)3265 Snack_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 
3292 Snack_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 
3308 Snack_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 
3324 Snack_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 
3340 Snack_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 
3356 Snack_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 
3372 Snack_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 
3388 Snack_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 
3404 Snack_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 
3420 void
SnackDefineFileFormats(Tcl_Interp * interp)3421 SnackDefineFileFormats(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 
3449 int
OpenLinkedFile(Sound * s,SnackLinkedFileInfo * infoPtr)3450 OpenLinkedFile(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 
3480 void
CloseLinkedFile(SnackLinkedFileInfo * infoPtr)3481 CloseLinkedFile(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 
3503 float junkBuffer[PBSIZE];
3504 
3505 float
GetSample(SnackLinkedFileInfo * infoPtr,int index)3506 GetSample(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 
3659 Snack_FileFormat *
Snack_GetFileFormats()3660 Snack_GetFileFormats()
3661 {
3662   return snackFileFormats;
3663 }
3664