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 <stdio.h>
24 #include <signal.h>
25 #include <math.h>
26 #include <string.h>
27 #include "tcl.h"
28 #include "snack.h"
29
30 extern int wop, rop;
31
32 extern int
33 ParseSoundCmd(ClientData cdata, Tcl_Interp *interp, int objc,
34 Tcl_Obj *CONST objv[], char** namep, Sound** sp);
35
36 extern int littleEndian;
37
38 int
Snack_AddCallback(Sound * s,updateProc * proc,ClientData cd)39 Snack_AddCallback(Sound *s, updateProc *proc, ClientData cd)
40 {
41 jkCallback *cb = (jkCallback *) ckalloc(sizeof(jkCallback));
42
43 if (cb == NULL) return(-1);
44 cb->proc = proc;
45 cb->clientData = cd;
46 if (s->firstCB != NULL) {
47 cb->id = s->firstCB->id + 1;
48 } else {
49 cb->id = 1;
50 }
51 cb->next = s->firstCB;
52 s->firstCB = cb;
53
54 if (s->debug > 1) { Snack_WriteLogInt(" Snack_AddCallback", cb->id); }
55
56 return(cb->id);
57 }
58
59 void
Snack_RemoveCallback(Sound * s,int id)60 Snack_RemoveCallback(Sound *s, int id)
61 {
62 jkCallback *cb = s->firstCB, **pp = &s->firstCB, *cbGoner = NULL;
63
64 if (s->debug > 1) Snack_WriteLogInt(" Snack_RemoveCallback", id);
65
66 if (id == -1) return;
67
68 while (cb != NULL) {
69 if (cb->id == id) {
70 cbGoner = cb;
71 cb = cb->next;
72 *pp = cb;
73 ckfree((char *)cbGoner);
74 return;
75 } else {
76 pp = &cb->next;
77 cb = cb->next;
78 }
79 }
80 }
81
82 void
Snack_ExecCallbacks(Sound * s,int flag)83 Snack_ExecCallbacks(Sound *s, int flag)
84 {
85 jkCallback *cb;
86
87 if (s->debug > 1) Snack_WriteLog(" Enter Snack_ExecCallbacks\n");
88
89 for (cb = s->firstCB; cb != NULL; cb = cb->next) {
90 if (s->debug > 2) Snack_WriteLogInt(" Executing callback", cb->id);
91 (cb->proc)(cb->clientData, flag);
92 if (s->debug > 2) Snack_WriteLog(" callback done\n");
93 }
94
95 if (s->changeCmdPtr != NULL) {
96 Tcl_Obj *cmd = NULL;
97
98 cmd = Tcl_NewListObj(0, NULL);
99 Tcl_ListObjAppendElement(s->interp, cmd, s->changeCmdPtr);
100
101 if (flag == SNACK_NEW_SOUND) {
102 Tcl_ListObjAppendElement(s->interp, cmd, Tcl_NewStringObj("New", -1));
103 } else if (flag == SNACK_DESTROY_SOUND) {
104 Tcl_ListObjAppendElement(s->interp, cmd, Tcl_NewStringObj("Destroyed",
105 -1));
106 } else {
107 Tcl_ListObjAppendElement(s->interp, cmd, Tcl_NewStringObj("More", -1));
108 }
109 Tcl_Preserve((ClientData) s->interp);
110 if (Tcl_GlobalEvalObj(s->interp, cmd) != TCL_OK) {
111 Tcl_AddErrorInfo(s->interp, "\n (\"command\" script)");
112 Tcl_BackgroundError(s->interp);
113 }
114 Tcl_Release((ClientData) s->interp);
115 }
116 }
117
118 void
Snack_GetExtremes(Sound * s,SnackLinkedFileInfo * info,int start,int end,int chan,float * pmax,float * pmin)119 Snack_GetExtremes(Sound *s, SnackLinkedFileInfo *info, int start, int end,
120 int chan, float *pmax, float *pmin)
121 {
122 int i, inc;
123 float maxs, mins;
124
125 if (s->length == 0) {
126 if (s->encoding == LIN8OFFSET) {
127 *pmax = 128.0f;
128 *pmin = 128.0f;
129 } else {
130 *pmax = 0.0f;
131 *pmin = 0.0f;
132 }
133 return;
134 }
135
136 if (chan == -1) {
137 inc = 1;
138 chan = 0;
139 } else {
140 inc = s->nchannels;
141 }
142
143 start = start * s->nchannels + chan;
144 end = end * s->nchannels + chan;
145
146 switch (s->encoding) {
147 case LIN8OFFSET:
148 maxs = 0.0f;
149 mins = 255.0f;
150 break;
151 case LIN8:
152 maxs = -128.0f;
153 mins = 127.0f;
154 break;
155 case LIN24:
156 case LIN24PACKED:
157 maxs = -8388608.0f;
158 mins = 8388607.0f;
159 break;
160 case LIN32:
161 maxs = -2147483648.0f;
162 mins = 2147483647.0f;
163 break;
164 default:
165 maxs = -32768.0f;
166 mins = 32767.0f;
167 }
168
169 if (s->precision == SNACK_SINGLE_PREC) {
170 if (s->storeType == SOUND_IN_MEMORY) {
171 for (i = start; i <= end; i += inc) {
172 float tmp = FSAMPLE(s, i);
173 if (tmp > maxs) {
174 maxs = tmp;
175 }
176 if (tmp < mins) {
177 mins = tmp;
178 }
179 }
180 } else {
181 for (i = start; i <= end; i += inc) {
182 float tmp = GetSample(info, i);
183 if (tmp > maxs) {
184 maxs = tmp;
185 }
186 if (tmp < mins) {
187 mins = tmp;
188 }
189 }
190 }
191 } else {
192 if (s->storeType == SOUND_IN_MEMORY) {
193 for (i = start; i <= end; i += inc) {
194 float tmp = (float) DSAMPLE(s, i);
195 if (tmp > maxs) {
196 maxs = tmp;
197 }
198 if (tmp < mins) {
199 mins = tmp;
200 }
201 }
202 } else {
203 for (i = start; i <= end; i += inc) {
204 float tmp = GetSample(info, i);
205 if (tmp > maxs) {
206 maxs = tmp;
207 }
208 if (tmp < mins) {
209 mins = tmp;
210 }
211 }
212 }
213 }
214 if (maxs < mins) {
215 maxs = mins;
216 }
217 if (mins > maxs) {
218 mins = maxs;
219 }
220
221 *pmax = maxs;
222 *pmin = mins;
223 }
224
225 void
Snack_UpdateExtremes(Sound * s,int start,int end,int flag)226 Snack_UpdateExtremes(Sound *s, int start, int end, int flag)
227 {
228 float maxs, mins, newmax, newmin;
229
230 if (flag == SNACK_NEW_SOUND) {
231 s->maxsamp = -32768.0f;
232 s->minsamp = 32767.0f;
233 }
234
235 maxs = s->maxsamp;
236 mins = s->minsamp;
237
238 Snack_GetExtremes(s, NULL, start, end - 1, -1, &newmax, &newmin);
239
240 if (newmax > maxs) {
241 s->maxsamp = newmax;
242 } else {
243 s->maxsamp = maxs;
244 }
245 if (newmin < mins) {
246 s->minsamp = newmin;
247 } else {
248 s->minsamp = mins;
249 }
250 if (s->maxsamp > -s->minsamp)
251 s->abmax = s->maxsamp;
252 else
253 s->abmax = -s->minsamp;
254 }
255
256 short
Snack_SwapShort(short s)257 Snack_SwapShort(short s)
258 {
259 char tc, *p;
260
261 p = (char *) &s;
262 tc = *p;
263 *p = *(p+1);
264 *(p+1) = tc;
265
266 return(s);
267 }
268
269 long
Snack_SwapLong(long l)270 Snack_SwapLong(long l)
271 {
272 char tc, *p;
273
274 p = (char *) &l;
275 tc = *p;
276 *p = *(p+3);
277 *(p+3) = tc;
278
279 tc = *(p+1);
280 *(p+1) = *(p+2);
281 *(p+2) = tc;
282
283 return(l);
284 }
285
286 float
Snack_SwapFloat(float f)287 Snack_SwapFloat(float f)
288 {
289 char tc, *p;
290
291 p = (char *) &f;
292 tc = *p;
293 *p = *(p+3);
294 *(p+3) = tc;
295
296 tc = *(p+1);
297 *(p+1) = *(p+2);
298 *(p+2) = tc;
299
300 return(f);
301 }
302
303 double
Snack_SwapDouble(double d)304 Snack_SwapDouble(double d)
305 {
306 char tc, *p;
307
308 p = (char *) &d;
309 tc = *p;
310 *p = *(p+7);
311 *(p+7) = tc;
312
313 tc = *(p+1);
314 *(p+1) = *(p+6);
315 *(p+6) = tc;
316
317 tc = *(p+2);
318 *(p+2) = *(p+5);
319 *(p+5) = tc;
320
321 tc = *(p+3);
322 *(p+3) = *(p+4);
323 *(p+4) = tc;
324
325 return(d);
326 }
327
328 extern struct Snack_FileFormat *snackFileFormats;
329
330 void
Snack_DeleteSound(Sound * s)331 Snack_DeleteSound(Sound *s)
332 {
333 jkCallback *currCB;
334 Snack_FileFormat *ff;
335
336 if (s->debug > 1) {
337 Snack_WriteLog(" Enter Snack_DeleteSound\n");
338 }
339
340 Snack_ResizeSoundStorage(s, 0);
341 ckfree((char *) s->blocks);
342 if (s->storeType == SOUND_IN_FILE && s->linkInfo.linkCh != NULL) {
343 CloseLinkedFile(&s->linkInfo);
344 }
345
346 for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
347 if (strcmp(s->fileType, ff->name) == 0) {
348 if (ff->freeHeaderProc != NULL) {
349 (ff->freeHeaderProc)(s);
350 }
351 }
352 }
353
354 if (s->fcname != NULL) {
355 ckfree((char *)s->fcname);
356 }
357 if (s->filterName != NULL) {
358 ckfree(s->filterName);
359 }
360
361 Snack_ExecCallbacks(s, SNACK_DESTROY_SOUND);
362 currCB = s->firstCB;
363 while (currCB != NULL) {
364 if (s->debug > 1) Snack_WriteLogInt(" Freed callback", currCB->id);
365 ckfree((char *)currCB);
366 currCB = currCB->next;
367 }
368
369 if (s->changeCmdPtr != NULL) {
370 Tcl_DecrRefCount(s->changeCmdPtr);
371 }
372
373 if (s->cmdPtr != NULL) {
374 Tcl_DecrRefCount(s->cmdPtr);
375 }
376
377 if (s->debug > 1) {
378 Snack_WriteLog(" Sound object freed\n");
379 }
380
381 ckfree((char *) s);
382 }
383
384 int
Snack_ResizeSoundStorage(Sound * s,int len)385 Snack_ResizeSoundStorage(Sound *s, int len)
386 {
387 int neededblks, i, blockSize, sampSize;
388
389 if (s->debug > 1) Snack_WriteLogInt(" Enter ResizeSoundStorage", len);
390
391 if (s->precision == SNACK_SINGLE_PREC) {
392 blockSize = FBLKSIZE;
393 sampSize = sizeof(float);
394 } else {
395 blockSize = DBLKSIZE;
396 sampSize = sizeof(double);
397 }
398 neededblks = 1 + (len * s->nchannels - 1) / blockSize;
399
400 if (len == 0) {
401 neededblks = 0;
402 s->exact = 0;
403 }
404
405 if (neededblks > s->maxblks) {
406 void *tmp = ckrealloc((char *)s->blocks, neededblks * sizeof(float*));
407
408 if (tmp == NULL) {
409 if (s->debug > 2) Snack_WriteLogInt(" realloc failed", neededblks);
410 return TCL_ERROR;
411 }
412 s->maxblks = neededblks;
413 s->blocks = (float **)tmp;
414 }
415
416 if (s->maxlength == 0 && len * s->nchannels < blockSize) {
417
418 /* Allocate exactly as much as needed. */
419
420 if (s->debug > 2) Snack_WriteLogInt(" Allocating minimal block",
421 len*s->nchannels * sizeof(float));
422
423 s->exact = len * s->nchannels * sampSize;
424 if ((s->blocks[0] = (float *) ckalloc(s->exact)) == NULL) {
425 return TCL_ERROR;
426 }
427 i = 1;
428 s->maxlength = len;
429 } else if (neededblks > s->nblks) {
430 float *tmp = s->blocks[0];
431
432 if (s->debug > 2) {
433 Snack_WriteLogInt(" Allocating full block(s)", neededblks - s->nblks);
434 }
435
436 /* Do not count exact block, needs to be re-allocated */
437 if (s->exact > 0) {
438 s->nblks = 0;
439 }
440
441 for (i = s->nblks; i < neededblks; i++) {
442 if ((s->blocks[i] = (float *) ckalloc(CBLKSIZE)) == NULL) {
443 break;
444 }
445 }
446 if (i < neededblks) {
447 if (s->debug > 2) Snack_WriteLogInt(" block alloc failed", i);
448 for (--i; i >= s->nblks; i--) {
449 ckfree((char *) s->blocks[i]);
450 }
451 return TCL_ERROR;
452 }
453
454 /* Copy and de-allocate any exact block */
455 if (s->exact > 0) {
456 memcpy(s->blocks[0], tmp, s->exact);
457 ckfree((char *) tmp);
458 s->exact = 0;
459 }
460
461 s->maxlength = neededblks * blockSize / s->nchannels;
462 } else if (neededblks == 1 && s->exact > 0) {
463
464 /* Reallocate to one full block */
465
466 float *tmp = (float *) ckalloc(CBLKSIZE);
467
468 if (s->debug > 2) {
469 Snack_WriteLogInt(" Reallocating full block", CBLKSIZE);
470 }
471
472 if (tmp != NULL) {
473 memcpy(tmp, s->blocks[0], s->exact);
474 ckfree((char *) s->blocks[0]);
475 s->blocks[0] = tmp;
476 s->maxlength = blockSize / s->nchannels;
477 }
478 s->exact = 0;
479 }
480
481 if (neededblks < s->nblks) {
482 for (i = neededblks; i < s->nblks; i++) {
483 ckfree((char *) s->blocks[i]);
484 }
485 s->maxlength = neededblks * blockSize / s->nchannels;
486 }
487
488 s->nblks = neededblks;
489
490 if (s->debug > 1) Snack_WriteLogInt(" Exit ResizeSoundStorage", neededblks);
491
492 return TCL_OK;
493 }
494
495 char *encs[] = { "", "Lin16", "Alaw", "Mulaw", "Lin8offset", "Lin8",
496 "Lin24", "Lin32", "Float", "Double", "Lin24packed" };
497
498 int
GetChannels(Tcl_Interp * interp,Tcl_Obj * obj,int * nchannels)499 GetChannels(Tcl_Interp *interp, Tcl_Obj *obj, int *nchannels)
500 {
501 int length, val;
502 char *str = Tcl_GetStringFromObj(obj, &length);
503
504 if (strncasecmp(str, "MONO", length) == 0) {
505 *nchannels = SNACK_MONO;
506 return TCL_OK;
507 }
508 if (strncasecmp(str, "STEREO", length) == 0) {
509 *nchannels = SNACK_STEREO;
510 return TCL_OK;
511 }
512 if (strncasecmp(str, "QUAD", length) == 0) {
513 *nchannels = SNACK_QUAD;
514 return TCL_OK;
515 }
516 if (Tcl_GetIntFromObj(interp, obj, &val) != TCL_OK) return TCL_ERROR;
517 if (val < 1) {
518 Tcl_AppendResult(interp, "Number of channels must be >= 1", NULL);
519 return TCL_ERROR;
520 }
521 *nchannels = val;
522 return TCL_OK;
523 }
524
525 int
GetEncoding(Tcl_Interp * interp,Tcl_Obj * obj,int * encoding,int * sampsize)526 GetEncoding(Tcl_Interp *interp, Tcl_Obj *obj, int *encoding, int *sampsize)
527 {
528 int length;
529 char *str = Tcl_GetStringFromObj(obj, &length);
530
531 if (strncasecmp(str, "LIN16", length) == 0) {
532 *encoding = LIN16;
533 *sampsize = 2;
534 } else if (strncasecmp(str, "LIN24", length) == 0) {
535 *encoding = LIN24;
536 *sampsize = 4;
537 } else if (strncasecmp(str, "LIN24PACKED", length) == 0) {
538 *encoding = LIN24PACKED;
539 *sampsize = 3;
540 } else if (strncasecmp(str, "LIN32", length) == 0) {
541 *encoding = LIN32;
542 *sampsize = 4;
543 } else if (strncasecmp(str, "FLOAT", length) == 0) {
544 *encoding = SNACK_FLOAT;
545 *sampsize = 4;
546 } else if (strncasecmp(str, "DOUBLE", length) == 0) {
547 *encoding = SNACK_DOUBLE;
548 *sampsize = 8;
549 } else if (strncasecmp(str, "ALAW", length) == 0) {
550 *encoding = ALAW;
551 *sampsize = 1;
552 } else if (strncasecmp(str, "MULAW", length) == 0) {
553 *encoding = MULAW;
554 *sampsize = 1;
555 } else if (strncasecmp(str, "LIN8", length) == 0) {
556 *encoding = LIN8;
557 *sampsize = 1;
558 } else if (strncasecmp(str, "LIN8OFFSET", length) == 0) {
559 *encoding = LIN8OFFSET;
560 *sampsize = 1;
561 } else {
562 Tcl_AppendResult(interp, "Unknown encoding", NULL);
563 return TCL_ERROR;
564 }
565 return TCL_OK;
566 }
567
568 void
SwapIfBE(Sound * s)569 SwapIfBE(Sound *s)
570 {
571 if (littleEndian) {
572 s->swap = 0;
573 } else {
574 s->swap = 1;
575 }
576 }
577
578 void
SwapIfLE(Sound * s)579 SwapIfLE(Sound *s)
580 {
581 if (littleEndian) {
582 s->swap = 1;
583 } else {
584 s->swap = 0;
585 }
586 }
587
588 static int
infoCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])589 infoCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
590 {
591 Tcl_Obj *objs[8];
592
593 objs[0] = Tcl_NewIntObj(s->length);
594 objs[1] = Tcl_NewIntObj(s->samprate);
595 if (s->encoding == SNACK_FLOAT) {
596 objs[2] = Tcl_NewDoubleObj((double)s->maxsamp);
597 objs[3] = Tcl_NewDoubleObj((double)s->minsamp);
598 } else {
599 objs[2] = Tcl_NewIntObj((int)s->maxsamp);
600 objs[3] = Tcl_NewIntObj((int)s->minsamp);
601 }
602 objs[4] = Tcl_NewStringObj(encs[s->encoding], -1);
603 objs[5] = Tcl_NewIntObj(s->nchannels);
604 objs[6] = Tcl_NewStringObj(s->fileType, -1);
605 objs[7] = Tcl_NewIntObj(s->headSize);
606
607 Tcl_SetObjResult(interp, Tcl_NewListObj(8, objs));
608 return TCL_OK;
609 }
610
611 static int
maxCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])612 maxCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
613 {
614 int startpos = 0, endpos = s->length - 1, arg, channel = -1;
615 float maxsamp, minsamp;
616 SnackLinkedFileInfo info;
617 static CONST84 char *subOptionStrings[] = {
618 "-start", "-end", "-channel", NULL
619 };
620 enum subOptions {
621 START, END, CHANNEL
622 };
623
624 for (arg = 2; arg < objc; arg+=2) {
625 int index;
626
627 if (Tcl_GetIndexFromObj(interp, objv[arg], subOptionStrings,
628 "option", 0, &index) != TCL_OK) {
629 return TCL_ERROR;
630 }
631
632 if (arg + 1 == objc) {
633 Tcl_AppendResult(interp, "No argument given for ",
634 subOptionStrings[index], " option", (char *) NULL);
635 return TCL_ERROR;
636 }
637
638 switch ((enum subOptions) index) {
639 case START:
640 {
641 if (Tcl_GetIntFromObj(interp, objv[arg+1], &startpos) != TCL_OK)
642 return TCL_ERROR;
643 break;
644 }
645 case END:
646 {
647 if (Tcl_GetIntFromObj(interp, objv[arg+1], &endpos) != TCL_OK)
648 return TCL_ERROR;
649 break;
650 }
651 case CHANNEL:
652 {
653 char *str = Tcl_GetStringFromObj(objv[arg+1], NULL);
654 if (GetChannel(interp, str, s->nchannels, &channel) != TCL_OK) {
655 return TCL_ERROR;
656 break;
657 }
658 }
659 }
660 }
661 if (endpos < 0) endpos = s->length - 1;
662
663 if (startpos < 0 || (startpos >= s->length && startpos > 0)) {
664 Tcl_AppendResult(interp, "Start value out of bounds", NULL);
665 return TCL_ERROR;
666 }
667 if (endpos >= s->length) {
668 Tcl_AppendResult(interp, "End value out of bounds", NULL);
669 return TCL_ERROR;
670 }
671
672 if (objc == 2) {
673 if (s->encoding == SNACK_FLOAT) {
674 Tcl_SetObjResult(interp, Tcl_NewDoubleObj((double)s->maxsamp));
675 } else {
676 Tcl_SetObjResult(interp, Tcl_NewIntObj((int)s->maxsamp));
677 }
678 } else {
679 if (s->storeType != SOUND_IN_MEMORY) {
680 OpenLinkedFile(s, &info);
681 }
682 Snack_GetExtremes(s, &info, startpos, endpos, channel, &maxsamp, &minsamp);
683 if (s->storeType != SOUND_IN_MEMORY) {
684 CloseLinkedFile(&info);
685 }
686 if (s->encoding == SNACK_FLOAT) {
687 Tcl_SetObjResult(interp, Tcl_NewDoubleObj((double)maxsamp));
688 } else {
689 Tcl_SetObjResult(interp, Tcl_NewIntObj((int)maxsamp));
690 }
691 }
692
693 return TCL_OK;
694 }
695
696 static int
minCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])697 minCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
698 {
699 int startpos = 0, endpos = s->length - 1, arg, channel = -1;
700 float maxsamp, minsamp;
701 SnackLinkedFileInfo info;
702 static CONST84 char *subOptionStrings[] = {
703 "-start", "-end", "-channel", NULL
704 };
705 enum subOptions {
706 START, END, CHANNEL
707 };
708
709 for (arg = 2; arg < objc; arg+=2) {
710 int index;
711
712 if (Tcl_GetIndexFromObj(interp, objv[arg], subOptionStrings,
713 "option", 0, &index) != TCL_OK) {
714 return TCL_ERROR;
715 }
716
717 if (arg + 1 == objc) {
718 Tcl_AppendResult(interp, "No argument given for ",
719 subOptionStrings[index], " option", (char *) NULL);
720 return TCL_ERROR;
721 }
722
723 switch ((enum subOptions) index) {
724 case START:
725 {
726 if (Tcl_GetIntFromObj(interp, objv[arg+1], &startpos) != TCL_OK)
727 return TCL_ERROR;
728 break;
729 }
730 case END:
731 {
732 if (Tcl_GetIntFromObj(interp, objv[arg+1], &endpos) != TCL_OK)
733 return TCL_ERROR;
734 break;
735 }
736 case CHANNEL:
737 {
738 char *str = Tcl_GetStringFromObj(objv[arg+1], NULL);
739 if (GetChannel(interp, str, s->nchannels, &channel) != TCL_OK) {
740 return TCL_ERROR;
741 }
742 break;
743 }
744 }
745 }
746 if (endpos < 0) endpos = s->length - 1;
747
748 if (startpos < 0 || (startpos >= s->length && startpos > 0)) {
749 Tcl_AppendResult(interp, "Start value out of bounds", NULL);
750 return TCL_ERROR;
751 }
752 if (endpos >= s->length) {
753 Tcl_AppendResult(interp, "End value out of bounds", NULL);
754 return TCL_ERROR;
755 }
756
757 if (objc == 2) {
758 if (s->encoding == SNACK_FLOAT) {
759 Tcl_SetObjResult(interp, Tcl_NewDoubleObj((double)s->minsamp));
760 } else {
761 Tcl_SetObjResult(interp, Tcl_NewIntObj((int)s->minsamp));
762 }
763 } else {
764 if (s->storeType != SOUND_IN_MEMORY) {
765 OpenLinkedFile(s, &info);
766 }
767 Snack_GetExtremes(s, &info, startpos, endpos, channel, &maxsamp, &minsamp);
768 if (s->storeType != SOUND_IN_MEMORY) {
769 CloseLinkedFile(&info);
770 }
771 if (s->encoding == SNACK_FLOAT) {
772 Tcl_SetObjResult(interp, Tcl_NewDoubleObj((double)minsamp));
773 } else {
774 Tcl_SetObjResult(interp, Tcl_NewIntObj((int)minsamp));
775 }
776 }
777
778 return TCL_OK;
779 }
780
781 static int
changedCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])782 changedCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
783 {
784 if (objc != 3) {
785 Tcl_WrongNumArgs(interp, 1, objv, "changed new|more");
786 return TCL_ERROR;
787 }
788 if (s->storeType == SOUND_IN_MEMORY) {
789 Snack_UpdateExtremes(s, 0, s->length, SNACK_NEW_SOUND);
790 }
791 if (objc > 2) {
792 char *string = Tcl_GetStringFromObj(objv[2], NULL);
793
794 if (strcasecmp(string, "new") == 0) {
795 Snack_ExecCallbacks(s, SNACK_NEW_SOUND);
796 return TCL_OK;
797 }
798 if (strcasecmp(string, "more") == 0) {
799 Snack_ExecCallbacks(s, SNACK_MORE_SOUND);
800 return TCL_OK;
801 }
802 Tcl_AppendResult(interp, "unknow option, must be new or more",
803 (char *) NULL);
804 return TCL_ERROR;
805 }
806
807 return TCL_OK;
808 }
809
810 static int
destroyCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])811 destroyCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
812 {
813 char *string = Tcl_GetStringFromObj(objv[0], NULL);
814 int debug = s->debug;
815
816 if (debug > 0) Snack_WriteLog("Enter destroyCmd\n");
817
818 if (s->writeStatus == WRITE) {
819 s->destroy = 1;
820 }
821 s->length = 0;
822 if (wop == IDLE) {
823 Snack_StopSound(s, interp);
824 }
825 Tcl_DeleteHashEntry(Tcl_FindHashEntry(s->soundTable, string));
826
827 Tcl_DeleteCommand(interp, string);
828
829 /*
830 The sound command and associated Sound struct are now deallocated
831 because SoundDeleteCmd has been called as a result of Tcl_DeleteCommand().
832 */
833
834 if (debug > 0) Snack_WriteLog("Exit destroyCmd\n");
835
836 return TCL_OK;
837 }
838
839 int
flushCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])840 flushCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
841 {
842 if (s->storeType != SOUND_IN_MEMORY) {
843 Tcl_AppendResult(interp, "flush only works with in-memory sounds",
844 (char *) NULL);
845 return TCL_ERROR;
846 }
847
848 Snack_StopSound(s, interp);
849 Snack_ResizeSoundStorage(s, 0);
850 s->length = 0;
851 s->maxsamp = 0.0f;
852 s->minsamp = 0.0f;
853 s->abmax = 0.0f;
854 Snack_ExecCallbacks(s, SNACK_NEW_SOUND);
855
856 return TCL_OK;
857 }
858
859 static int
configureCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])860 configureCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
861 {
862 int arg, filearg = 0, newobjc;
863 Tcl_Obj **newobjv = NULL;
864 static CONST84 char *optionStrings[] = {
865 "-load", "-file", "-channel", "-rate", "-frequency", "-channels",
866 "-encoding", "-format", "-byteorder", "-buffersize", "-skiphead",
867 "-guessproperties", "-precision", "-changecommand", "-fileformat",
868 "-debug", NULL
869 };
870 enum options {
871 OPTLOAD, OPTFILE, CHANNEL, RATE, FREQUENCY, CHANNELS, ENCODING, FORMAT,
872 BYTEORDER, BUFFERSIZE, SKIPHEAD, GUESSPROPS, PRECISION, CHGCMD, FILEFORMAT,
873 OPTDEBUG
874 };
875 Snack_FileFormat *ff;
876
877 if (s->debug > 0) { Snack_WriteLog("Enter configureCmd\n"); }
878
879 Snack_RemoveOptions(objc-2, objv+2, optionStrings, &newobjc,
880 (Tcl_Obj **) &newobjv);
881 if (newobjc > 0) {
882 for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
883 if (strcmp(s->fileType, ff->name) == 0) {
884 if (ff->configureProc != NULL) {
885 if ((ff->configureProc)(s, interp, objc, objv)) return TCL_OK;
886 }
887 }
888 }
889 }
890 for (arg = 0; arg <newobjc; arg++) {
891 Tcl_DecrRefCount(newobjv[arg]);
892 }
893 ckfree((char *)newobjv);
894
895 if (objc == 2) { /* get all options */
896 Tcl_Obj *objs[6];
897
898 objs[0] = Tcl_NewIntObj(s->length);
899 objs[1] = Tcl_NewIntObj(s->samprate);
900 if (s->encoding == SNACK_FLOAT) {
901 objs[2] = Tcl_NewDoubleObj((double)s->maxsamp);
902 objs[3] = Tcl_NewDoubleObj((double)s->minsamp);
903 } else {
904 objs[2] = Tcl_NewIntObj((int)s->maxsamp);
905 objs[3] = Tcl_NewIntObj((int)s->minsamp);
906 }
907 objs[4] = Tcl_NewStringObj(encs[s->encoding], -1);
908 objs[5] = Tcl_NewIntObj(s->nchannels);
909
910 Tcl_SetObjResult(interp, Tcl_NewListObj(6, objs));
911
912 return TCL_OK;
913 } else if (objc == 3) { /* get option */
914 int index;
915
916 if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0,
917 &index) != TCL_OK) {
918 return TCL_ERROR;
919 }
920
921 switch ((enum options) index) {
922 case OPTLOAD:
923 {
924 if (s->storeType == SOUND_IN_MEMORY) {
925 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fcname, -1));
926 } else {
927 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
928 }
929 break;
930 }
931 case OPTFILE:
932 {
933 if (s->storeType == SOUND_IN_FILE) {
934 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fcname, -1));
935 } else {
936 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
937 }
938 break;
939 }
940 case CHANNEL:
941 {
942 if (s->storeType == SOUND_IN_CHANNEL) {
943 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fcname, -1));
944 } else {
945 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
946 }
947 break;
948 }
949 case RATE:
950 case FREQUENCY:
951 {
952 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->samprate));
953 break;
954 }
955 case CHANNELS:
956 {
957 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->nchannels));
958 break;
959 }
960 case ENCODING:
961 case FORMAT:
962 {
963 Tcl_SetObjResult(interp, Tcl_NewStringObj(encs[s->encoding], -1));
964 break;
965 }
966 case BYTEORDER:
967 if (s->sampsize > 1) {
968 if (littleEndian) {
969 if (s->swap) {
970 Tcl_SetObjResult(interp, Tcl_NewStringObj("bigEndian", -1));
971 } else {
972 Tcl_SetObjResult(interp, Tcl_NewStringObj("littleEndian", -1));
973 }
974 } else {
975 if (s->swap) {
976 Tcl_SetObjResult(interp, Tcl_NewStringObj("littleEndian", -1));
977 } else {
978 Tcl_SetObjResult(interp, Tcl_NewStringObj("bigEndian", -1));
979 }
980 }
981 } else {
982 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
983 }
984 break;
985 case BUFFERSIZE:
986 {
987 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->buffersize));
988 break;
989 }
990 case SKIPHEAD:
991 {
992 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->skipBytes));
993 break;
994 }
995 case GUESSPROPS:
996 break;
997 case PRECISION:
998 {
999 if (s->precision == SNACK_DOUBLE_PREC) {
1000 Tcl_SetObjResult(interp, Tcl_NewStringObj("double", -1));
1001 } else {
1002 Tcl_SetObjResult(interp, Tcl_NewStringObj("single", -1));
1003 }
1004 break;
1005 }
1006 case CHGCMD:
1007 {
1008 Tcl_SetObjResult(interp, s->changeCmdPtr);
1009 break;
1010 }
1011 case FILEFORMAT:
1012 {
1013 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fileType, -1));
1014 break;
1015 }
1016 case OPTDEBUG:
1017 {
1018 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->debug));
1019 break;
1020 }
1021 }
1022 } else { /* set option */
1023
1024 s->guessEncoding = -1;
1025 s->guessRate = -1;
1026
1027 for (arg = 2; arg < objc; arg+=2) {
1028 int index;
1029
1030 if (Tcl_GetIndexFromObj(interp, objv[arg], optionStrings, "option", 0,
1031 &index) != TCL_OK) {
1032 return TCL_ERROR;
1033 }
1034
1035 if (arg + 1 == objc) {
1036 Tcl_AppendResult(interp, "No argument given for ",
1037 optionStrings[index], " option", (char *) NULL);
1038 return TCL_ERROR;
1039 }
1040
1041 switch ((enum options) index) {
1042 case OPTLOAD:
1043 {
1044 filearg = arg + 1;
1045 s->storeType = SOUND_IN_MEMORY;
1046 break;
1047 }
1048 case OPTFILE:
1049 {
1050 filearg = arg + 1;
1051 s->storeType = SOUND_IN_FILE;
1052 break;
1053 }
1054 case CHANNEL:
1055 {
1056 filearg = arg + 1;
1057 s->storeType = SOUND_IN_CHANNEL;
1058 break;
1059 }
1060 case RATE:
1061 case FREQUENCY:
1062 {
1063 if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->samprate) != TCL_OK)
1064 return TCL_ERROR;
1065 s->guessRate = 0;
1066 break;
1067 }
1068 case CHANNELS:
1069 {
1070 int oldn = s->nchannels;
1071
1072 if (GetChannels(interp, objv[arg+1], &s->nchannels) != TCL_OK)
1073 return TCL_ERROR;
1074 if (oldn != s->nchannels) {
1075 s->length = s->length * oldn / s->nchannels;
1076 }
1077 break;
1078 }
1079 case ENCODING:
1080 case FORMAT:
1081 {
1082 if (GetEncoding(interp, objv[arg+1], &s->encoding, &s->sampsize) \
1083 != TCL_OK) {
1084 return TCL_ERROR;
1085 }
1086 s->guessEncoding = 0;
1087 break;
1088 }
1089 case BYTEORDER:
1090 {
1091 int length;
1092 char *str = Tcl_GetStringFromObj(objv[arg+1], &length);
1093 if (strncasecmp(str, "littleEndian", length) == 0) {
1094 SwapIfBE(s);
1095 } else if (strncasecmp(str, "bigEndian", length) == 0) {
1096 SwapIfLE(s);
1097 } else {
1098 Tcl_AppendResult(interp, "-byteorder option should be bigEndian",
1099 " or littleEndian", NULL);
1100 return TCL_ERROR;
1101 }
1102 s->guessEncoding = 0;
1103 break;
1104 }
1105 case BUFFERSIZE:
1106 {
1107 if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->buffersize) != TCL_OK)
1108 return TCL_ERROR;
1109 break;
1110 }
1111 case SKIPHEAD:
1112 {
1113 if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->skipBytes) != TCL_OK)
1114 return TCL_ERROR;
1115 break;
1116 }
1117 case GUESSPROPS:
1118 {
1119 int guessProps;
1120 if (Tcl_GetBooleanFromObj(interp, objv[arg+1], &guessProps) !=TCL_OK)
1121 return TCL_ERROR;
1122 if (guessProps) {
1123 if (s->guessEncoding == -1) s->guessEncoding = 1;
1124 if (s->guessRate == -1) s->guessRate = 1;
1125 }
1126 break;
1127 }
1128 case PRECISION:
1129 {
1130 int length;
1131 char *str = Tcl_GetStringFromObj(objv[arg+1], &length);
1132 if (strncasecmp(str, "double", length) == 0) {
1133 s->precision = SNACK_DOUBLE_PREC;
1134 } else if (strncasecmp(str, "single", length) == 0) {
1135 s->precision = SNACK_SINGLE_PREC;
1136 } else {
1137 Tcl_AppendResult(interp, "-precision option should be single",
1138 " or double", NULL);
1139 return TCL_ERROR;
1140 }
1141 break;
1142 }
1143 case CHGCMD:
1144 {
1145 if (s->changeCmdPtr != NULL) {
1146 Tcl_DecrRefCount(s->changeCmdPtr);
1147 }
1148 s->changeCmdPtr = Tcl_DuplicateObj(objv[arg+1]);
1149 Tcl_IncrRefCount(s->changeCmdPtr);
1150 break;
1151 }
1152 case FILEFORMAT:
1153 {
1154 if (strlen(Tcl_GetStringFromObj(objv[arg+1], NULL)) > 0) {
1155 if (GetFileFormat(interp, objv[arg+1], &s->fileType) != TCL_OK) {
1156 return TCL_ERROR;
1157 }
1158 s->forceFormat = 1;
1159 }
1160 break;
1161 }
1162 case OPTDEBUG:
1163 {
1164 if (arg+1 == objc) {
1165 Tcl_AppendResult(interp, "No debug flag given", NULL);
1166 return TCL_ERROR;
1167 }
1168 if (Tcl_GetIntFromObj(interp, objv[arg+1], &s->debug) != TCL_OK) {
1169 return TCL_ERROR;
1170 }
1171 break;
1172 }
1173 }
1174 }
1175 if (s->guessEncoding == -1) s->guessEncoding = 0;
1176 if (s->guessRate == -1) s->guessRate = 0;
1177
1178 if (filearg > 0) {
1179 if (Tcl_IsSafe(interp)) {
1180 Tcl_AppendResult(interp, "can not read sound file in a safe",
1181 " interpreter", (char *) NULL);
1182 return TCL_ERROR;
1183 }
1184 if (SetFcname(s, interp, objv[filearg]) != TCL_OK) {
1185 return TCL_ERROR;
1186 }
1187 }
1188
1189 if (filearg > 0 && strlen(s->fcname) > 0) {
1190 if (s->storeType == SOUND_IN_MEMORY) {
1191 char *type = LoadSound(s, interp, NULL, 0, -1);
1192
1193 if (type == NULL) {
1194 return TCL_ERROR;
1195 }
1196 Snack_UpdateExtremes(s, 0, s->length, SNACK_NEW_SOUND);
1197 } else if (s->storeType == SOUND_IN_FILE) {
1198 Snack_FileFormat *ff;
1199
1200 if (s->linkInfo.linkCh != NULL) {
1201 CloseLinkedFile(&s->linkInfo);
1202 s->linkInfo.linkCh = NULL;
1203 }
1204 for (ff = snackFileFormats; ff != NULL; ff = ff->nextPtr) {
1205 if (strcmp(s->fileType, ff->name) == 0) {
1206 if (ff->freeHeaderProc != NULL) {
1207 (ff->freeHeaderProc)(s);
1208 }
1209 }
1210 }
1211 if (GetHeader(s, interp, NULL) != TCL_OK) {
1212 s->fileType = NameGuessFileType(s->fcname);
1213 }
1214 Snack_ResizeSoundStorage(s, 0);
1215 if (s->encoding == LIN8OFFSET) {
1216 s->maxsamp = 128.0f;
1217 s->minsamp = 128.0f;
1218 } else {
1219 s->maxsamp = 0.0f;
1220 s->minsamp = 0.0f;
1221 }
1222 } else if (s->storeType == SOUND_IN_CHANNEL) {
1223 int mode = 0;
1224
1225 Snack_ResizeSoundStorage(s, 0);
1226 s->rwchan = Tcl_GetChannel(interp, s->fcname, &mode);
1227 if (!(mode & TCL_READABLE)) {
1228 s->rwchan = NULL;
1229 }
1230 if (s->rwchan != NULL) {
1231 Tcl_SetChannelOption(interp, s->rwchan, "-translation", "binary");
1232 #ifdef TCL_81_API
1233 Tcl_SetChannelOption(interp, s->rwchan, "-encoding", "binary");
1234 #endif
1235 }
1236 }
1237 }
1238 if (filearg > 0 && strlen(s->fcname) == 0) {
1239 if (s->storeType == SOUND_IN_FILE) {
1240 s->length = 0;
1241 }
1242 }
1243 Snack_ExecCallbacks(s, SNACK_NEW_SOUND);
1244 }
1245 if (s->debug > 0) { Snack_WriteLog("Exit configureCmd\n"); }
1246
1247 return TCL_OK;
1248 }
1249
1250 static int
cgetCmd(Sound * s,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1251 cgetCmd(Sound *s, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1252 {
1253 static CONST84 char *optionStrings[] = {
1254 "-load", "-file", "-channel", "-rate", "-frequency", "-channels",
1255 "-encoding", "-format", "-byteorder", "-buffersize", "-skiphead",
1256 "-guessproperties", "-precision", "-changecommand", "-fileformat",
1257 "-debug", NULL
1258 };
1259 enum options {
1260 OPTLOAD, OPTFILE, CHANNEL, RATE, FREQUENCY, CHANNELS, ENCODING, FORMAT,
1261 BYTEORDER, BUFFERSIZE, SKIPHEAD, GUESSPROPS, PRECISION, CHGCMD, FILEFORMAT,
1262 OPTDEBUG
1263 };
1264
1265 if (objc == 2) {
1266 Tcl_WrongNumArgs(interp, 1, objv, "cget option");
1267 return TCL_ERROR;
1268 } else if (objc == 3) { /* get option */
1269 int index;
1270
1271 if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0,
1272 &index) != TCL_OK) {
1273 return TCL_ERROR;
1274 }
1275
1276 switch ((enum options) index) {
1277 case OPTLOAD:
1278 {
1279 if (s->storeType == SOUND_IN_MEMORY) {
1280 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fcname, -1));
1281 } else {
1282 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
1283 }
1284 break;
1285 }
1286 case OPTFILE:
1287 {
1288 if (s->storeType == SOUND_IN_FILE) {
1289 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fcname, -1));
1290 } else {
1291 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
1292 }
1293 break;
1294 }
1295 case CHANNEL:
1296 {
1297 if (s->storeType == SOUND_IN_CHANNEL) {
1298 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fcname, -1));
1299 } else {
1300 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
1301 }
1302 break;
1303 }
1304 case RATE:
1305 case FREQUENCY:
1306 {
1307 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->samprate));
1308 break;
1309 }
1310 case CHANNELS:
1311 {
1312 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->nchannels));
1313 break;
1314 }
1315 case ENCODING:
1316 case FORMAT:
1317 {
1318 Tcl_SetObjResult(interp, Tcl_NewStringObj(encs[s->encoding], -1));
1319 break;
1320 }
1321 case BYTEORDER:
1322 if (s->sampsize > 1) {
1323 if (littleEndian) {
1324 if (s->swap) {
1325 Tcl_SetObjResult(interp, Tcl_NewStringObj("bigEndian", -1));
1326 } else {
1327 Tcl_SetObjResult(interp, Tcl_NewStringObj("littleEndian", -1));
1328 }
1329 } else {
1330 if (s->swap) {
1331 Tcl_SetObjResult(interp, Tcl_NewStringObj("littleEndian", -1));
1332 } else {
1333 Tcl_SetObjResult(interp, Tcl_NewStringObj("bigEndian", -1));
1334 }
1335 }
1336 } else {
1337 Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
1338 }
1339 break;
1340 case BUFFERSIZE:
1341 {
1342 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->buffersize));
1343 break;
1344 }
1345 case SKIPHEAD:
1346 {
1347 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->skipBytes));
1348 break;
1349 }
1350 case GUESSPROPS:
1351 break;
1352 case CHGCMD:
1353 {
1354 Tcl_SetObjResult(interp, s->changeCmdPtr);
1355 break;
1356 }
1357 case PRECISION:
1358 {
1359 if (s->precision == SNACK_DOUBLE_PREC) {
1360 Tcl_SetObjResult(interp, Tcl_NewStringObj("double", -1));
1361 } else {
1362 Tcl_SetObjResult(interp, Tcl_NewStringObj("single", -1));
1363 }
1364 break;
1365 }
1366 case FILEFORMAT:
1367 {
1368 Tcl_SetObjResult(interp, Tcl_NewStringObj(s->fileType, -1));
1369 break;
1370 }
1371 case OPTDEBUG:
1372 {
1373 Tcl_SetObjResult(interp, Tcl_NewIntObj(s->debug));
1374 break;
1375 }
1376 }
1377 }
1378
1379 return TCL_OK;
1380 }
1381
1382 int filterSndCmd(Sound *s, Tcl_Interp *interp, int objc,
1383 Tcl_Obj *CONST objv[]);
1384
1385 #define NSOUNDCOMMANDS 45
1386 #define MAXSOUNDCOMMANDS 100
1387
1388 static int nSoundCommands = NSOUNDCOMMANDS;
1389 static int maxSoundCommands = MAXSOUNDCOMMANDS;
1390
1391 CONST84 char *sndCmdNames[MAXSOUNDCOMMANDS] = {
1392 "play",
1393 "read",
1394 "record",
1395 "stop",
1396 "write",
1397
1398 "data",
1399 "crop",
1400 "info",
1401 "length",
1402 "current_position",
1403
1404 "max",
1405 "min",
1406 "sample",
1407 "changed",
1408 "copy",
1409
1410 "append",
1411 "concatenate",
1412 "insert",
1413 "cut",
1414 "destroy",
1415
1416 "flush",
1417 "configure",
1418 "cget",
1419 "pause",
1420 "convert",
1421
1422 "dBPowerSpectrum",
1423 "pitch",
1424 "reverse",
1425 "shape",
1426 "datasamples",
1427
1428 "filter",
1429 "swap",
1430 "power",
1431 "formant",
1432 "speatures",
1433
1434 "an",
1435 "mix",
1436 "stretch",
1437 "co",
1438 "powerSpectrum",
1439
1440 "vp",
1441 "join",
1442 "lastIndex",
1443 "fit",
1444 "ina",
1445
1446 NULL
1447 };
1448
1449 /* NOTE: NSOUNDCOMMANDS needs updating when new commands are added. */
1450
1451 soundCmd *sndCmdProcs[MAXSOUNDCOMMANDS] = {
1452 playCmd,
1453 readCmd,
1454 recordCmd,
1455 stopCmd,
1456 writeCmd,
1457 dataCmd,
1458 cropCmd,
1459 infoCmd,
1460 lengthCmd,
1461 current_positionCmd,
1462 maxCmd,
1463 minCmd,
1464 sampleCmd,
1465 changedCmd,
1466 copyCmd,
1467 appendCmd,
1468 concatenateCmd,
1469 insertCmd,
1470 cutCmd,
1471 destroyCmd,
1472 flushCmd,
1473 configureCmd,
1474 cgetCmd,
1475 pauseCmd,
1476 convertCmd,
1477 dBPowerSpectrumCmd,
1478 pitchCmd,
1479 reverseCmd,
1480 shapeCmd,
1481 dataSamplesCmd,
1482 filterSndCmd,
1483 swapCmd,
1484 powerCmd,
1485 formantCmd,
1486 speaturesCmd,
1487 alCmd,
1488 mixCmd,
1489 stretchCmd,
1490 ocCmd,
1491 powerSpectrumCmd,
1492 vpCmd,
1493 joinCmd,
1494 lastIndexCmd,
1495 fitCmd,
1496 inaCmd
1497 };
1498
1499 soundDelCmd *sndDelCmdProcs[MAXSOUNDCOMMANDS] = {
1500 NULL,
1501 NULL,
1502 NULL,
1503 NULL,
1504 NULL,
1505 NULL,
1506 NULL,
1507 NULL,
1508 NULL,
1509 NULL,
1510 NULL,
1511 NULL,
1512 NULL,
1513 NULL,
1514 NULL,
1515 NULL,
1516 NULL,
1517 NULL,
1518 NULL,
1519 NULL,
1520 NULL,
1521 NULL,
1522 NULL,
1523 NULL,
1524 NULL,
1525 NULL,
1526 NULL,
1527 NULL,
1528 NULL,
1529 NULL,
1530 NULL,
1531 NULL,
1532 NULL,
1533 NULL,
1534 NULL,
1535 NULL,
1536 NULL,
1537 NULL,
1538 NULL,
1539 NULL,
1540 NULL,
1541 NULL,
1542 NULL,
1543 NULL,
1544 NULL,
1545 NULL,
1546 NULL,
1547 NULL
1548 };
1549
1550 #ifdef __cplusplus
1551 extern "C"
1552 #endif
1553 int
SoundCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1554 SoundCmd(ClientData clientData, Tcl_Interp *interp, int objc,
1555 Tcl_Obj *CONST objv[])
1556 {
1557 register Sound *s = (Sound *) clientData;
1558 int index;
1559
1560 if (objc < 2) {
1561 Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
1562 return TCL_ERROR;
1563 }
1564
1565 if (Tcl_GetIndexFromObj(interp, objv[1], sndCmdNames, "option", 0,
1566 &index) != TCL_OK) {
1567 return TCL_ERROR;
1568 }
1569
1570 return((sndCmdProcs[index])(s, interp, objc, objv));
1571 }
1572
1573 Sound *
Snack_NewSound(int rate,int encoding,int nchannels)1574 Snack_NewSound(int rate, int encoding, int nchannels)
1575 {
1576 Sound *s = (Sound *) ckalloc(sizeof(Sound));
1577
1578 if (s == NULL) {
1579 return NULL;
1580 }
1581
1582 /* Default sound specifications */
1583
1584 s->samprate = rate;
1585 s->encoding = encoding;
1586 if (s->encoding == LIN16) {
1587 s->sampsize = 2;
1588 } else if (s->encoding == LIN24 || s->encoding == LIN32
1589 || s->encoding == SNACK_FLOAT) {
1590 s->sampsize = 4;
1591 } else if (s->encoding == LIN24PACKED) {
1592 s->sampsize = 3;
1593 } else {
1594 s->sampsize = 1;
1595 }
1596 if (s->encoding == LIN8OFFSET) {
1597 s->maxsamp = 128.0f;
1598 s->minsamp = 128.0f;
1599 } else {
1600 s->maxsamp = 0.0f;
1601 s->minsamp = 0.0f;
1602 }
1603 s->nchannels = nchannels;
1604 s->length = 0;
1605 s->maxlength = 0;
1606 s->abmax = 0.0f;
1607 s->readStatus = IDLE;
1608 s->writeStatus = IDLE;
1609 s->firstCB = NULL;
1610 s->fileType = RAW_STRING;
1611 s->tmpbuf = NULL;
1612 s->swap = 0;
1613 s->headSize = 0;
1614 s->skipBytes = 0;
1615 s->storeType = SOUND_IN_MEMORY;
1616 s->fcname = NULL;
1617 s->interp = NULL;
1618 s->cmdPtr = NULL;
1619 s->blocks = (float **) ckalloc(MAXNBLKS * sizeof(float*));
1620 if (s->blocks == NULL) {
1621 ckfree((char *) s);
1622 return NULL;
1623 }
1624 s->blocks[0] = NULL;
1625 s->maxblks = MAXNBLKS;
1626 s->nblks = 0;
1627 s->exact = 0;
1628 s->precision = SNACK_SINGLE_PREC;
1629 s->blockingPlay = 0;
1630 s->debug = 0;
1631 s->destroy = 0;
1632 s->guessEncoding = 0;
1633 s->guessRate = 0;
1634 s->rwchan = NULL;
1635 s->firstNRead = 0;
1636 s->buffersize = 0;
1637 s->forceFormat = 0;
1638 s->itemRefCnt = 0;
1639 s->validStart = 0;
1640 s->linkInfo.linkCh = NULL;
1641 s->linkInfo.eof = 0;
1642 s->inByteOrder = SNACK_NATIVE;
1643 s->devStr = NULL;
1644 s->soundTable = NULL;
1645 s->filterName = NULL;
1646 s->extHead = NULL;
1647 s->extHeadType = 0;
1648 s->extHead2 = NULL;
1649 s->extHead2Type = 0;
1650 s->loadOffset = 0;
1651 s->changeCmdPtr = NULL;
1652 s->userFlag = 0;
1653 s->userData = NULL;
1654
1655 return s;
1656 }
1657
1658 void
CleanSound(Sound * s,Tcl_Interp * interp,char * name)1659 CleanSound(Sound *s, Tcl_Interp *interp, char *name)
1660 {
1661 Snack_DeleteSound(s);
1662 Tcl_DeleteHashEntry(Tcl_FindHashEntry(s->soundTable, name));
1663 }
1664
1665 extern int defaultSampleRate;
1666
1667 int
ParseSoundCmd(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[],char ** namep,Sound ** sp)1668 ParseSoundCmd(ClientData cdata, Tcl_Interp *interp, int objc,
1669 Tcl_Obj *CONST objv[], char** namep, Sound** sp)
1670 {
1671 Sound *s;
1672 int arg, arg1, filearg = 0, flag;
1673 static int id = 0;
1674 int samprate = defaultSampleRate, nchannels = 1;
1675 int encoding = LIN16, sampsize = 2;
1676 int storeType = -1, guessEncoding = -1, guessRate = -1;
1677 int forceFormat = -1, skipBytes = -1, buffersize = -1;
1678 int guessProps = 0, swapIfBE = -1, debug = -1, precision = -1;
1679 char *fileType = NULL;
1680 static char ids[20];
1681 char *name;
1682 Tcl_HashTable *hTab = (Tcl_HashTable *) cdata;
1683 Tcl_HashEntry *hPtr;
1684 int length = 0;
1685 char *string = NULL;
1686 Tcl_Obj *cmdPtr = NULL;
1687 static CONST84 char *optionStrings[] = {
1688 "-load", "-file", "-rate", "-frequency", "-channels", "-encoding",
1689 "-format", "-channel", "-byteorder", "-buffersize", "-skiphead",
1690 "-guessproperties", "-fileformat", "-precision", "-changecommand",
1691 "-debug", NULL
1692 };
1693 enum options {
1694 OPTLOAD, OPTFILE, RATE, FREQUENCY, CHANNELS, ENCODING, FORMAT, CHANNEL,
1695 BYTEORDER, BUFFERSIZE, SKIPHEAD, GUESSPROPS, FILEFORMAT,
1696 PRECISION, CHGCMD, OPTDEBUG
1697 };
1698
1699 if (objc > 1) {
1700 string = Tcl_GetStringFromObj(objv[1], &length);
1701 }
1702 if ((objc == 1) || (string[0] == '-')) {
1703 do {
1704 sprintf(ids, "sound%d", ++id);
1705 } while (Tcl_FindHashEntry(hTab, ids) != NULL);
1706 name = ids;
1707 arg1 = 1;
1708 } else {
1709 name = string;
1710 arg1 = 2;
1711 }
1712 *namep = name;
1713
1714 hPtr = Tcl_FindHashEntry(hTab, name);
1715 if (hPtr != NULL) {
1716 Sound *t = (Sound *) Tcl_GetHashValue(hPtr);
1717 Snack_StopSound(t, interp);
1718 Tcl_DeleteCommand(interp, name);
1719 }
1720
1721 for (arg = arg1; arg < objc; arg += 2) {
1722 int index;
1723
1724 if (Tcl_GetIndexFromObj(interp, objv[arg], optionStrings, "option", 0,
1725 &index) != TCL_OK) {
1726 return TCL_ERROR;
1727 }
1728
1729 if (arg + 1 == objc) {
1730 Tcl_AppendResult(interp, "No argument given for ",
1731 optionStrings[index], " option", (char *) NULL);
1732 return TCL_ERROR;
1733 }
1734
1735 switch ((enum options) index) {
1736 case OPTLOAD:
1737 {
1738 if (arg+1 == objc) {
1739 Tcl_AppendResult(interp, "No filename given", NULL);
1740 return TCL_ERROR;
1741 }
1742 filearg = arg + 1;
1743 storeType = SOUND_IN_MEMORY;
1744 break;
1745 }
1746 case OPTFILE:
1747 {
1748 if (arg+1 == objc) {
1749 Tcl_AppendResult(interp, "No filename given", NULL);
1750 return TCL_ERROR;
1751 }
1752 filearg = arg + 1;
1753 storeType = SOUND_IN_FILE;
1754 break;
1755 }
1756 case RATE:
1757 case FREQUENCY:
1758 {
1759 if (Tcl_GetIntFromObj(interp, objv[arg+1], &samprate) != TCL_OK) {
1760 return TCL_ERROR;
1761 }
1762 guessRate = 0;
1763 break;
1764 }
1765 case CHANNELS:
1766 {
1767 if (GetChannels(interp, objv[arg+1], &nchannels) != TCL_OK) {
1768 return TCL_ERROR;
1769 }
1770 break;
1771 }
1772 case ENCODING:
1773 case FORMAT:
1774 {
1775 if (GetEncoding(interp, objv[arg+1], &encoding, &sampsize) != TCL_OK) {
1776 return TCL_ERROR;
1777 }
1778 guessEncoding = 0;
1779 break;
1780 }
1781 case CHANNEL:
1782 {
1783 if (arg+1 == objc) {
1784 Tcl_AppendResult(interp, "No channel name given", NULL);
1785 return TCL_ERROR;
1786 }
1787 filearg = arg + 1;
1788 storeType = SOUND_IN_CHANNEL;
1789 break;
1790 }
1791 case OPTDEBUG:
1792 {
1793 if (arg+1 == objc) {
1794 Tcl_AppendResult(interp, "No debug flag given", NULL);
1795 return TCL_ERROR;
1796 }
1797 if (Tcl_GetIntFromObj(interp, objv[arg+1], &debug) != TCL_OK) {
1798 return TCL_ERROR;
1799 }
1800 break;
1801 }
1802 case FILEFORMAT:
1803 {
1804 if (strlen(Tcl_GetStringFromObj(objv[arg+1], NULL)) > 0) {
1805 if (GetFileFormat(interp, objv[arg+1], &fileType) != TCL_OK) {
1806 return TCL_ERROR;
1807 }
1808 forceFormat = 1;
1809 }
1810 break;
1811 }
1812 case BYTEORDER:
1813 {
1814 char *str = Tcl_GetStringFromObj(objv[arg+1], &length);
1815 if (strncasecmp(str, "littleEndian", length) == 0) {
1816 swapIfBE = 1;
1817 } else if (strncasecmp(str, "bigEndian", length) == 0) {
1818 swapIfBE = 0;
1819 } else {
1820 Tcl_AppendResult(interp, "-byteorder option should be bigEndian or littleEndian", NULL);
1821 return TCL_ERROR;
1822 }
1823 guessEncoding = 0;
1824 break;
1825 }
1826 case BUFFERSIZE:
1827 {
1828 if (Tcl_GetIntFromObj(interp, objv[arg+1], &buffersize) != TCL_OK)
1829 return TCL_ERROR;
1830 break;
1831 }
1832
1833 case SKIPHEAD:
1834 {
1835 if (Tcl_GetIntFromObj(interp, objv[arg+1], &skipBytes) != TCL_OK)
1836 return TCL_ERROR;
1837 break;
1838 }
1839 case GUESSPROPS:
1840 {
1841 if (Tcl_GetBooleanFromObj(interp, objv[arg+1], &guessProps) !=TCL_OK)
1842 return TCL_ERROR;
1843 break;
1844 }
1845 case PRECISION:
1846 {
1847 char *str = Tcl_GetStringFromObj(objv[arg+1], &length);
1848 if (strncasecmp(str, "double", length) == 0) {
1849 precision = SNACK_DOUBLE_PREC;
1850 } else if (strncasecmp(str, "single", length) == 0) {
1851 precision = SNACK_SINGLE_PREC;
1852 } else {
1853 Tcl_AppendResult(interp, "-precision option should be single",
1854 " or double", NULL);
1855 return TCL_ERROR;
1856 }
1857 break;
1858 }
1859 case CHGCMD:
1860 {
1861 char *str = Tcl_GetStringFromObj(objv[arg+1], NULL);
1862
1863 if (strlen(str) > 0) {
1864 cmdPtr = Tcl_DuplicateObj(objv[arg+1]);
1865 Tcl_IncrRefCount(cmdPtr);
1866 }
1867 break;
1868 }
1869 }
1870 }
1871
1872 if ((*sp = s = Snack_NewSound(samprate, encoding, nchannels)) == NULL) {
1873 Tcl_AppendResult(interp, "Could not allocate new sound!", NULL);
1874 return TCL_ERROR;
1875 }
1876
1877 hPtr = Tcl_CreateHashEntry(hTab, name, &flag);
1878 Tcl_SetHashValue(hPtr, (ClientData) s);
1879 s->soundTable = hTab;
1880
1881 if (guessProps) {
1882 if (guessEncoding == -1) {
1883 s->guessEncoding = 1;
1884 }
1885 if (guessRate == -1) {
1886 s->guessRate = 1;
1887 }
1888 }
1889 if (storeType != -1) {
1890 s->storeType = storeType;
1891 }
1892 if (buffersize != -1) {
1893 s->buffersize = buffersize;
1894 }
1895 if (skipBytes != -1) {
1896 s->skipBytes = skipBytes;
1897 }
1898 if (debug != -1) {
1899 s->debug = debug;
1900 }
1901 if (fileType != NULL) {
1902 s->fileType = fileType;
1903 }
1904 if (forceFormat != -1) {
1905 s->forceFormat = forceFormat;
1906 }
1907 if (precision != -1) {
1908 s->precision = precision;
1909 }
1910 if (swapIfBE == 0) {
1911 SwapIfLE(s);
1912 }
1913 if (swapIfBE == 1) {
1914 SwapIfBE(s);
1915 }
1916 if (cmdPtr != NULL) {
1917 s->changeCmdPtr = cmdPtr;
1918 }
1919
1920 /* s->fcname = strdup(name); */
1921 s->interp = interp;
1922
1923 if (filearg > 0) {
1924 if (Tcl_IsSafe(interp)) {
1925 Tcl_AppendResult(interp, "can not read sound file in a safe interpreter",
1926 (char *) NULL);
1927 CleanSound(s, interp, name);
1928 return TCL_ERROR;
1929 }
1930 if (SetFcname(s, interp, objv[filearg]) != TCL_OK) {
1931 CleanSound(s, interp, name);
1932 return TCL_ERROR;
1933 }
1934 }
1935
1936 if (filearg > 0 && strlen(s->fcname) > 0) {
1937 if (s->storeType == SOUND_IN_MEMORY) {
1938 char *type = LoadSound(s, interp, NULL, 0, -1);
1939
1940 if (type == NULL) {
1941 CleanSound(s, interp, name);
1942 return TCL_ERROR;
1943 }
1944 Snack_UpdateExtremes(s, 0, s->length, SNACK_NEW_SOUND);
1945 } else if (s->storeType == SOUND_IN_FILE) {
1946 if (GetHeader(s, interp, NULL) != TCL_OK) {
1947 s->fileType = NameGuessFileType(s->fcname);
1948 }
1949 if (s->encoding == LIN8OFFSET) {
1950 s->maxsamp = 128.0f;
1951 s->minsamp = 128.0f;
1952 } else {
1953 s->maxsamp = 0.0f;
1954 s->minsamp = 0.0f;
1955 }
1956 } else if (s->storeType == SOUND_IN_CHANNEL) {
1957 int mode = 0;
1958
1959 s->rwchan = Tcl_GetChannel(interp, s->fcname, &mode);
1960 if (!(mode & TCL_READABLE)) {
1961 s->rwchan = NULL;
1962 }
1963 if (s->rwchan != NULL) {
1964 Tcl_SetChannelOption(interp, s->rwchan, "-translation", "binary");
1965 #ifdef TCL_81_API
1966 Tcl_SetChannelOption(interp, s->rwchan, "-encoding", "binary");
1967 #endif
1968 }
1969 }
1970 }
1971
1972 return TCL_OK;
1973 }
1974
1975 static void
SoundDeleteCmd(ClientData clientData)1976 SoundDeleteCmd(ClientData clientData)
1977 {
1978 register Sound *s = (Sound *) clientData;
1979 int i;
1980
1981 if (s->debug > 1) {
1982 Snack_WriteLog(" Sound obj cmd deleted\n");
1983 }
1984 if (s->destroy == 0) {
1985 Snack_StopSound(s, s->interp);
1986 }
1987 for (i = 0; i < nSoundCommands; i++) {
1988 if (sndDelCmdProcs[i] != NULL) {
1989 (sndDelCmdProcs[i])(s);
1990 }
1991 }
1992 if (s->destroy == 0 || wop == IDLE) {
1993 Snack_DeleteSound(s);
1994 }
1995 }
1996
1997 int
Snack_SoundCmd(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1998 Snack_SoundCmd(ClientData cdata, Tcl_Interp *interp, int objc,
1999 Tcl_Obj *CONST objv[])
2000 {
2001 char *name;
2002 Sound *s = NULL;
2003
2004 if (ParseSoundCmd(cdata, interp, objc, objv, &name, &s) != TCL_OK ) {
2005 return TCL_ERROR;
2006 }
2007
2008 Tcl_CreateObjCommand(interp, name, SoundCmd, (ClientData) s,
2009 (Tcl_CmdDeleteProc *) SoundDeleteCmd);
2010
2011 Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
2012
2013 return TCL_OK;
2014 }
2015
2016 extern Tcl_HashTable *filterHashTable;
2017
2018 Sound *
Snack_GetSound(Tcl_Interp * interp,char * name)2019 Snack_GetSound(Tcl_Interp *interp, char *name)
2020 {
2021 Tcl_CmdInfo infoPtr;
2022 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(filterHashTable, name);
2023
2024 if (hPtr != NULL || Tcl_GetCommandInfo(interp, name, &infoPtr) == 0) {
2025 Tcl_AppendResult(interp, name, " : no such sound", (char *) NULL);
2026 return NULL;
2027 }
2028
2029 return (Sound *)infoPtr.objClientData;
2030 }
2031
2032 void
Snack_SoundDeleteCmd(ClientData clientData)2033 Snack_SoundDeleteCmd(ClientData clientData)
2034 {
2035 if (clientData != NULL) {
2036 Tcl_DeleteHashTable((Tcl_HashTable *) clientData);
2037 ckfree((char *) clientData);
2038 }
2039 }
2040
2041 extern int nAudioCommands;
2042 extern int maxAudioCommands;
2043 extern audioDelCmd *audioDelCmdProcs[];
2044 extern audioCmd *audioCmdProcs[];
2045 extern char *audioCmdNames[];
2046
2047 extern int nMixerCommands;
2048 extern int maxMixerCommands;
2049 extern mixerDelCmd *mixerDelCmdProcs[];
2050 extern mixerCmd *mixerCmdProcs[];
2051 extern char *mixerCmdNames[];
2052
2053 int
Snack_AddSubCmd(int snackCmd,char * cmdName,Snack_CmdProc * cmdProc,Snack_DelCmdProc * delCmdProc)2054 Snack_AddSubCmd(int snackCmd, char *cmdName, Snack_CmdProc *cmdProc,
2055 Snack_DelCmdProc *delCmdProc)
2056 {
2057 int i;
2058
2059 switch(snackCmd) {
2060 case SNACK_SOUND_CMD:
2061 if (nSoundCommands < maxSoundCommands) {
2062 for (i = 0; i < nSoundCommands; i++) {
2063 if (strcmp(sndCmdNames[i], cmdName) == 0) break;
2064 }
2065 sndCmdNames[i] = cmdName;
2066 sndCmdProcs[i] = (soundCmd *)cmdProc;
2067 sndDelCmdProcs[i] = (soundDelCmd *)delCmdProc;
2068 if (i == nSoundCommands) nSoundCommands++;
2069 }
2070 break;
2071 case SNACK_AUDIO_CMD:
2072 if (nAudioCommands < maxAudioCommands) {
2073 for (i = 0; i < nAudioCommands; i++) {
2074 if (strcmp(audioCmdNames[i], cmdName) == 0) break;
2075 }
2076 audioCmdNames[i] = cmdName;
2077 audioCmdProcs[i] = (audioCmd *)cmdProc;
2078 audioDelCmdProcs[i] = (audioDelCmd *)delCmdProc;
2079 if (i == nAudioCommands) nAudioCommands++;
2080 }
2081 break;
2082 case SNACK_MIXER_CMD:
2083 if (nMixerCommands < maxMixerCommands) {
2084 for (i = 0; i < nMixerCommands; i++) {
2085 if (strcmp(mixerCmdNames[i], cmdName) == 0) break;
2086 }
2087 mixerCmdNames[i] = cmdName;
2088 mixerCmdProcs[i] = (mixerCmd *)cmdProc;
2089 mixerDelCmdProcs[i] = (mixerDelCmd *)delCmdProc;
2090 if (i == nMixerCommands) nMixerCommands++;
2091 }
2092 break;
2093 }
2094
2095 return TCL_OK;
2096 }
2097
2098 int
SetFcname(Sound * s,Tcl_Interp * interp,Tcl_Obj * obj)2099 SetFcname(Sound *s, Tcl_Interp *interp, Tcl_Obj *obj)
2100 {
2101 int length;
2102 char *str = Tcl_GetStringFromObj(obj, &length);
2103
2104 if (s->fcname != NULL) {
2105 ckfree((char *)s->fcname);
2106 }
2107 if ((s->fcname = (char *) ckalloc((unsigned) (length + 1))) == NULL) {
2108 Tcl_AppendResult(interp, "Could not allocate name buffer!", NULL);
2109 return TCL_ERROR;
2110 }
2111 strcpy(s->fcname, str);
2112
2113 return TCL_OK;
2114 }
2115
2116 int
Snack_ProgressCallback(Tcl_Obj * cmdPtr,Tcl_Interp * interp,char * type,double fraction)2117 Snack_ProgressCallback(Tcl_Obj *cmdPtr, Tcl_Interp *interp, char *type,
2118 double fraction)
2119 {
2120 if (cmdPtr != NULL) {
2121 Tcl_Obj *cmd = NULL;
2122 int res;
2123
2124 cmd = Tcl_NewListObj(0, NULL);
2125 Tcl_ListObjAppendElement(interp, cmd, cmdPtr);
2126 Tcl_ListObjAppendElement(interp, cmd, Tcl_NewStringObj(type,-1));
2127 Tcl_ListObjAppendElement(interp, cmd, Tcl_NewDoubleObj(fraction));
2128 Tcl_Preserve((ClientData) interp);
2129 res = Tcl_GlobalEvalObj(interp, cmd);
2130 Tcl_Release((ClientData) interp);
2131 return res;
2132 }
2133 return TCL_OK;
2134 }
2135
2136 int
Snack_PlatformIsLittleEndian()2137 Snack_PlatformIsLittleEndian()
2138 {
2139 return(littleEndian);
2140 }
2141