1 /*
2 * Copyright (C) 1997-2003 Kare Sjolander <kare@speech.kth.se>
3 *
4 * This file contains a sample module which demonstrates how to write
5 * extensions to the Snack sound extension for Tcl/Tk.
6 * The latest version of Snack can be found at http://www.speech.kth.se/snack/
7 *
8 * This program is free software; you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation; either version 2 of the License, or
11 * (at your option) any later version.
12 *
13 * This program is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
17 *
18 * You should have received a copy of the GNU General Public License
19 * along with this program; if not, write to the Free Software
20 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 */
22
23 #include "snack.h"
24
25 #ifdef __cplusplus
26 extern "C" {
27 #endif
28
29 /* Windows magic */
30
31 #if defined(__WIN32__)
32 #define WIN32_LEAN_AND_MEAN
33 #include <windows.h>
34 #undef WIN32_LEAN_AND_MEAN
35 #define EXPORT(a,b) __declspec(dllexport) a b
36 BOOL APIENTRY
DllMain(HINSTANCE hInst,DWORD reason,LPVOID reserved)37 DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved)
38 {
39 return TRUE;
40 }
41 #else
42 #define EXPORT(a,b) a b
43 #endif
44
45 int
Square(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])46 Square(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
47 {
48 Sound *sound;
49 int i;
50
51 /* Get the sound structure for this sound */
52
53 sound = Snack_GetSound(interp, Tcl_GetStringFromObj(objv[0], NULL));
54
55 /* create a simple square wave */
56
57 for (i = 0; i < Snack_GetLength(sound); i++) {
58 if ((i/10)%2) {
59 Snack_SetSample(sound, 0, i, 10000.0f);
60 } else {
61 Snack_SetSample(sound, 0, i, -10000.0f);
62 }
63 }
64
65 /* update the max/min members of the sound structure */
66
67 Snack_UpdateExtremes(sound, 0, sound->length, SNACK_NEW_SOUND);
68
69 /* execute callbacks for stuff like canvas items */
70
71 Snack_ExecCallbacks(sound, SNACK_NEW_SOUND);
72
73 return TCL_OK;
74 }
75
76 /*
77 Initialize the square package and create a new sound command 'square'.
78 The syntax is: sndName square
79 */
80
EXPORT(int,Square_Init)81 EXPORT(int, Square_Init)(Tcl_Interp *interp)
82 {
83 #ifdef USE_TCL_STUBS
84 if (Tcl_InitStubs(interp, "8", 0) == NULL) {
85 return TCL_ERROR;
86 }
87 #endif
88
89 #ifdef USE_TK_STUBS
90 if (Tk_InitStubs(interp, "8", 0) == NULL) {
91 return TCL_ERROR;
92 }
93 #endif
94
95 #ifdef USE_SNACK_STUBS
96 if (Snack_InitStubs(interp, "2", 0) == NULL) {
97 return TCL_ERROR;
98 }
99 #endif
100
101 if (Tcl_PkgProvide(interp, "square", "1.0") != TCL_OK) {
102 return TCL_ERROR;
103 }
104
105 Snack_AddSubCmd(SNACK_SOUND_CMD, "square", (Snack_CmdProc *) Square, NULL);
106
107 return TCL_OK;
108 }
109
EXPORT(int,Square_SafeInit)110 EXPORT(int, Square_SafeInit)(Tcl_Interp *interp)
111 {
112 return Square_Init(interp);
113 }
114
115 #ifdef __cplusplus
116 }
117 #endif
118