1"======================================================================
2|
3|   SDL declarations
4|
5|
6 ======================================================================"
7
8
9"======================================================================
10|
11| Copyright 2006, 2008 Free Software Foundation, Inc.
12| Written by Brad Watson
13|
14| This file is part of the GNU Smalltalk class library.
15|
16| The GNU Smalltalk class library is free software; you can redistribute it
17| and/or modify it under the terms of the GNU Lesser General Public License
18| as published by the Free Software Foundation; either version 2.1, or (at
19| your option) any later version.
20|
21| The GNU Smalltalk class library is distributed in the hope that it will be
22| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
24| General Public License for more details.
25|
26| You should have received a copy of the GNU Lesser General Public License
27| along with the GNU Smalltalk class library; see the file COPYING.LIB.
28| If not, write to the Free Software Foundation, 59 Temple Place - Suite
29| 330, Boston, MA 02110-1301, USA.
30|
31 ======================================================================"
32
33
34"======================================================================
35|
36|   Notes: implemented without callbacks.
37|
38 ======================================================================"
39
40Object subclass: #SdlAudio
41    instanceVariableNames: ''
42    classVariableNames: ''
43    poolDictionaries: ''
44    category: 'LibSDL-Sound'! !
45
46CStruct subclass: #SdlAudioSpec
47    declaration: #(
48        (#freq #int)
49        (#format #short)
50        (#channels #int)
51        (#silence #int)
52        (#samples #short)
53        (#padding #short)
54        (#size #int)
55        (#callback (#ptr #CObject))
56        (#userData (#ptr #CObject)))
57    classVariableNames: ''
58    poolDictionaries: ''
59    category: 'LibSDL-Sound'! !
60
61CStruct subclass: #SdlAudioCvt
62    declaration: #(
63        (#needed #int)
64        (#srcFormat #short)
65        (#dstFormat #short)
66        (#rateIncr #double)
67        (#buf (#ptr #CObject))
68        (#len #int)
69        (#lenCvt #int)
70        (#lenMult #int)
71        (#lenRatio #double)
72        (#filter0 (#ptr #CObject))
73        (#filter1 (#ptr #CObject))
74        (#filter2 (#ptr #CObject))
75        (#filter3 (#ptr #CObject))
76        (#filter4 (#ptr #CObject))
77        (#filter5 (#ptr #CObject))
78        (#filter6 (#ptr #CObject))
79        (#filter7 (#ptr #CObject))
80        (#filter8 (#ptr #CObject))
81        (#filter9 (#ptr #CObject))
82        (#filterIndex #int))
83    classVariableNames: ''
84    poolDictionaries: ''
85    category: 'LibSDL-Sound'! !
86
87!SdlAudio class methodsFor: 'Constants'!
88
89audioU8
90    ^16r0008!
91
92audioS8
93    ^16r8008!
94
95audioU16LSB
96    ^16r0010!
97
98audioS16LSB
99    ^16r8010!
100
101audioU16MSB
102    ^16r1010!
103
104audioS16MSB
105    ^16r9010!
106
107audioU16
108    ^16r0010!
109
110audioS16
111    ^16r8010!
112
113audioU16Sys
114    ^16r0010!
115
116audioS16Sys
117    ^16r8010!
118
119sdlAudioStopped
120    ^0!
121
122sdlAudioPlaying
123    ^0!
124
125sdlAudioPaused
126    ^1!
127
128sdlMixMaxVolume
129    ^128!
130
131!SdlAudio class methodsFor: 'C call-outs'!
132
133sdlAudioInit: aString0
134    "I am normally used internally. My C function call prototype:
135
136    extern DECLSPEC int SDLCALL SDL_AudioInit(const char *driver_name);"
137    <cCall: 'SDL_AudioInit' returning: #int
138        args: #( #string )>!
139
140sdlAudioQuit
141    "I am normally used internally. My C function call prototype:
142
143    extern DECLSPEC void SDLCALL SDL_AudioQuit(void);"
144    <cCall: 'SDL_AudioQuit' returning: #void
145        args: #( )>!
146
147sdlAudioDriverName: aString0 maxLen: anInt1
148    "I fill the character buffer given to me with the name of the
149    current audio driver. My C function call prototype:
150
151    extern DECLSPEC char * SDLCALL SDL_AudioDriverName(char *namebuf,
152         int maxlen);"
153    <cCall: 'SDL_AudioDriverName' returning: #string
154        args: #( #string #int )>!
155
156sdlOpenAudio: aCobject0 obtained: aCobject1
157    "I open the audio device. My C function call prototype:
158
159    extern DECLSPEC int SDLCALL SDL_OpenAudio(SDL_AudioSpec *desired,
160         SDL_AudioSpec *obtained);"
161    <cCall: 'SDL_OpenAudio' returning: #int
162        args: #( #cObject #cObject )>!
163
164sdlGetAudioStatus
165    "I answer with the current audio state. My C function call prototype:
166
167     extern DECLSPEC SDL_audiostatus SDLCALL SDL_GetAudioStatus(void);"
168    <cCall: 'SDL_GetAudioStatus' returning: #cObject
169        args: #( )>!
170
171sdlPauseAudio: aInt0
172    "I pause or unpause the audio callback processing. My C function
173    call prototype:
174
175    extern DECLSPEC void SDLCALL SDL_PauseAudio(int pause_on);"
176    <cCall: 'SDL_PauseAudio' returning: #void
177        args: #( #int )>!
178
179sdlLoadWavRW: aCobject0 freeSrc: aInt1 spec: aCobject2 audioBuf: aCobjectPtr3
180    audioLen: aCobject4
181    "I load a wave from the data source given to me. My C function call prototype:
182
183    extern DECLSPEC SDL_AudioSpec * SDLCALL SDL_LoadWAV_RW(SDL_RWops *src,
184         int freesrc, SDL_AudioSpec *spec, Uint8 **audio_buf, Uint32 *audio_len);"
185    <cCall: 'SDL_LoadWAV_RW' returning: #cObject
186        args: #( #cObject #int #cObject #cObjectPtr #cObject  )>!
187
188sdlFreeWav: aCobject0
189    "I free data previously allocated with SDL_LoadWAV_RW(). My C
190    function call prototype:
191
192    extern DECLSPEC void SDLCALL SDL_FreeWAV(Uint8 *audio_buf);"
193    <cCall: 'SDL_FreeWAV' returning: #void
194        args: #( #cObject )>!
195
196sdlBuildAudioCvt: aCobject0 srcFormat: aInt1 srcChannels: aChar2 srcRate: aInt3
197    dstFormat: aInt4 dstChannels: aChar5 dstRate: aInt6
198    "I initialize a CVT for converting a buffer of audio data from one
199    format to the another. My C function call prototype:
200
201    extern DECLSPEC int SDLCALL SDL_BuildAudioCVT(SDL_AudioCVT *cvt,
202         Uint16 src_format, Uint8 src_channels, int src_rate,
203         Uint16 dst_format, Uint8 dst_channels, int dst_rate);"
204    <cCall: 'SDL_BuildAudioCVT' returning: #int
205        args: #( #cObject #int #char #int #int #char #int )>!
206
207sdlConvertAudio: aCobject0
208    "I convert a buffer of audio data in-place to the desired
209    format. My C function call prototype:
210
211    extern DECLSPEC int SDLCALL SDL_ConvertAudio(SDL_AudioCVT *cvt);"
212    <cCall: 'SDL_ConvertAudio' returning: #int
213        args: #( #cObject )>!
214
215sdlMixAudio: aCobject0 src: aCobject1 len: aUint2 volume: aInt3
216    "I take two audio buffers of the playing audio format and mix
217    them, performing addition, volume adjustment, and overflow
218    clipping. My C function call prototype:
219
220    extern DECLSPEC void SDLCALL SDL_MixAudio(Uint8 *dst, const Uint8 *src,
221         Uint32 len, int volume);"
222    <cCall: 'SDL_MixAudio' returning: #void
223        args: #( #cObject #cObject #uInt #int )>!
224
225sdlLockAudio
226    "I lock audio access to protect a callback function. My C function
227    call prototype:
228
229    extern DECLSPEC void SDLCALL SDL_LockAudio(void);"
230    <cCall: 'SDL_LockAudio' returning: #void
231        args: #( )>!
232
233sdlUnlockAudio
234    "I unlock audio access to protect a callback function. My C function
235    call prototype:
236
237    extern DECLSPEC void SDLCALL SDL_UnlockAudio(void);"
238    <cCall: 'SDL_UnlockAudio' returning: #void
239        args: #( )>!
240
241sdlCloseAudio
242    "I shut down audio processing and close the audio device. My C
243    function call prototype:
244
245    extern DECLSPEC void SDLCALL SDL_CloseAudio(void);"
246    <cCall: 'SDL_CloseAudio' returning: #void
247        args: #( )>! !
248