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 30extern int wop, rop; 31 32extern int 33ParseSoundCmd(ClientData cdata, Tcl_Interp *interp, int objc, 34 Tcl_Obj *CONST objv[], char** namep, Sound** sp); 35 36extern int littleEndian; 37 38int 39Snack_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 59void 60Snack_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 82void 83Snack_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 118void 119Snack_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 225void 226Snack_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 256short 257Snack_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 269long 270Snack_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 286float 287Snack_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 303double 304Snack_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 328extern struct Snack_FileFormat *snackFileFormats; 329 330void 331Snack_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 384int 385Snack_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 495char *encs[] = { "", "Lin16", "Alaw", "Mulaw", "Lin8offset", "Lin8", 496 "Lin24", "Lin32", "Float", "Double", "Lin24packed" }; 497 498int 499GetChannels(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 525int 526GetEncoding(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 568void 569SwapIfBE(Sound *s) 570{ 571 if (littleEndian) { 572 s->swap = 0; 573 } else { 574 s->swap = 1; 575 } 576} 577 578void 579SwapIfLE(Sound *s) 580{ 581 if (littleEndian) { 582 s->swap = 1; 583 } else { 584 s->swap = 0; 585 } 586} 587 588static int 589infoCmd(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 611static int 612maxCmd(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 696static int 697minCmd(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 781static int 782changedCmd(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 810static int 811destroyCmd(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 839int 840flushCmd(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 859static int 860configureCmd(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 1250static int 1251cgetCmd(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 1382int filterSndCmd(Sound *s, Tcl_Interp *interp, int objc, 1383 Tcl_Obj *CONST objv[]); 1384 1385#define NSOUNDCOMMANDS 45 1386#define MAXSOUNDCOMMANDS 100 1387 1388static int nSoundCommands = NSOUNDCOMMANDS; 1389static int maxSoundCommands = MAXSOUNDCOMMANDS; 1390 1391CONST84 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 1451soundCmd *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 1499soundDelCmd *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 1551extern "C" 1552#endif 1553int 1554SoundCmd(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 1573Sound * 1574Snack_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 1658void 1659CleanSound(Sound *s, Tcl_Interp *interp, char *name) 1660{ 1661 Snack_DeleteSound(s); 1662 Tcl_DeleteHashEntry(Tcl_FindHashEntry(s->soundTable, name)); 1663} 1664 1665extern int defaultSampleRate; 1666 1667int 1668ParseSoundCmd(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 1975static void 1976SoundDeleteCmd(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 1997int 1998Snack_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 2016extern Tcl_HashTable *filterHashTable; 2017 2018Sound * 2019Snack_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 2032void 2033Snack_SoundDeleteCmd(ClientData clientData) 2034{ 2035 if (clientData != NULL) { 2036 Tcl_DeleteHashTable((Tcl_HashTable *) clientData); 2037 ckfree((char *) clientData); 2038 } 2039} 2040 2041extern int nAudioCommands; 2042extern int maxAudioCommands; 2043extern audioDelCmd *audioDelCmdProcs[]; 2044extern audioCmd *audioCmdProcs[]; 2045extern char *audioCmdNames[]; 2046 2047extern int nMixerCommands; 2048extern int maxMixerCommands; 2049extern mixerDelCmd *mixerDelCmdProcs[]; 2050extern mixerCmd *mixerCmdProcs[]; 2051extern char *mixerCmdNames[]; 2052 2053int 2054Snack_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 2098int 2099SetFcname(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 2116int 2117Snack_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 2136int 2137Snack_PlatformIsLittleEndian() 2138{ 2139 return(littleEndian); 2140} 2141