Do own sound effects with QB64!

[Petr]

Hi.

I will gradually add simple (sometimes literally trivial) programs to this thread, which will allow you to do some sound effects. Of course, in order to use it as well easy in other programs, the output is saved as an audio .wav file.

The only limitation is that the audio input file must be WAV audio, 16 bit stereo, with a sampling frequency of 44100.

This is the first program in this occasional series: Add an echo to the sound. Use the AddEcho handle, the time at which the echo starts (for example, one tenth of a second after the sound starts, the number of echoes).

Wait a moment, the file will be created and played. It then remains on the disc.

I added a 1 piano key sound from TerryRitchie Piano program as the source audio file.

Code: QB64: [Select]

1. TYPE Snd
2.     Left AS SINGLE
3.     Right AS SINGLE
4. END TYPE
5. REDIM SHARED OutputSound(-1) AS Snd
6.  
7. TYPE OtpSndHelper
8.     Offset_Start AS LONG
9.     Offset_End AS LONG
10. END TYPE
11. REDIM SHARED OTP(1) AS OtpSndHelper
12. '----------------------------------------
13.  
14. handle = WAVtoRAW("1.wav") '                           write sound content as binary data to array OutputSound
15. REDIM echo(0) AS Snd
16. AddEcho handle, .1, 5, echo() '                           create new sound from old sound using echo in with time .1 seconds and 5 echoes
17.  
18.  
19. REDIM Longer(0) AS Snd
20. SNDARRCOPY echo(), 2, Longer() '                       copy done sound effect as 2 sounds consecutively
21. ERASE echo
22.  
23.  
24. SAVESOUND16S Longer(), "New_echo.wav" '                save new sound as file New_echo.wav
25. _SNDPLAYFILE "new_echo.wav" '                          play it
26. erase longer
27.  
28.  
29. SUB SNDARRCOPY (source() AS Snd, much AS INTEGER, dest() AS Snd)
30.     u = UBOUND(source)
31.     REDIM dest(u * much) AS Snd
32.     FOR c& = 1 TO much
33.         FOR d& = 1 TO u
34.             dest(i&) = source(d&)
35.             i& = i& + 1
36.     NEXT d&, c&
37. END SUB
38.  
39.  
40.  
41.  
42. 'delka echa v sekundach, pocet ozven
43. SUB AddEcho (handle, lenght AS SINGLE, echoes AS INTEGER, arr() AS Snd)
44.     Re = RawSize(handle)
45.     BLen& = 44100 * lenght
46.  
47.     size = Re + (BLen& * echoes)
48.     REDIM arr(size) AS Snd
49.     devol = 1 / echoes
50.     vol = 1
51.     FOR e = 1 TO echoes
52.         FOR c = OTP(handle).Offset_Start TO OTP(handle).Offset_End
53.             arr(i& + s).Left = OutputSound(c).Left * vol + arr(i& + s).Left
54.             arr(i& + s).Right = OutputSound(c).Right * vol + arr(i& + s).Right
55.             IF arr(i&).Left > .9 THEN arr(i&).Left = .9
56.             IF arr(i&).Left < -.9 THEN arr(i&).Left = -.9
57.             IF arr(i&).Right > .9 THEN arr(i&).Right = .9
58.             IF arr(i&).Right < -.9 THEN arr(i&).Right = -.9
59.             i& = i& + 1
60.         NEXT c
61.         s& = s& + BLen&
62.         i& = s&
63.         vol = vol - devol
64.     NEXT e
65. END SUB
66.  
67. FUNCTION RawSize& (handle)
68.     RawSize = OTP(handle).Offset_End - OTP(handle).Offset_Start
69. END FUNCTION
70.  
71.  
72. FUNCTION WAVtoRAW (file$) '                              Function load WAV file (this just 16bit, stereo format) and load it to array as RAW.
73.     TYPE head
74.         chunk AS STRING * 4 '       4 bytes  (RIFF)
75.         size AS LONG '              4 bytes  (?E??)
76.         fomat AS STRING * 4 '       4 bytes  (WAVE)
77.         sub1 AS STRING * 4 '        4 bytes  (fmt )
78.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
79.         format AS STRING * 2 '      2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
80.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
81.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
82.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
83.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
84.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
85.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
86.     END TYPE '                     40 bytes  total
87.     DIM H AS head
88.     ch = FREEFILE
89.  
90.     IF _FILEEXISTS(file$) THEN OPEN file$ FOR BINARY AS #ch ELSE PRINT file$; " not found": SLEEP 2: SYSTEM
91.     GET #ch, , H
92.  
93.     block = H.Block
94.     RATE = H.rate
95.     chan = H.channels
96.     bits = H.Bits
97.  
98.     SEEK #ch, Find_data_area(file$)
99.  
100.     OTP_Size = UBOUND(otp)
101.     OTP(OTP_Size).Offset_Start = UBOUND(outputsound) + 1
102.  
103.     DO WHILE NOT EOF(ch)
104.         IF bits = 16 AND chan = 2 THEN
105.             REDIM lefi AS INTEGER, righi AS INTEGER
106.             GET #ch, , lefi
107.             GET #ch, , righi
108.             lef = lefi / 65535
109.             righ = righi / 65535
110.         END IF
111.  
112.         IF RATE > 44100 THEN frekvence = RATE ELSE frekvence = 44100
113.  
114.         oss = UBOUND(OutputSound)
115.         REDIM _PRESERVE OutputSound(oss + (frekvence / RATE)) AS Snd
116.  
117.         FOR plll = 1 TO frekvence / RATE
118.             OutputSound(oss + plll).Left = lef
119.             OutputSound(oss + plll).Right = righ
120.         NEXT plll
121.  
122.         DO WHILE _SNDRAWLEN > 0: LOOP: REM comment this
123.     LOOP
124.  
125.     OTP(OTP_Size).Offset_End = UBOUND(outputsound)
126.     REDIM _PRESERVE OTP(OTP_Size + 1) AS OtpSndHelper
127.     CLOSE ch
128.     WAVtoRAW = OTP_Size
129. END FUNCTION
130.  
131. FUNCTION Find_data_area (handle$)
132.     REDIM D AS STRING * 1024
133.     ff = FREEFILE
134.     OPEN handle$ FOR BINARY AS #ff
135.     GET #ff, 1, D$
136.     CLOSE #ff
137.     Find_data_area = INSTR(1, D$, "data") + 8
138. END FUNCTION
139.  
140. SUB SAVESOUND16S (arr() AS Snd, file AS STRING)
141.  
142.     TYPE head16
143.         chunk AS STRING * 4 '       4 bytes  (RIFF)
144.         size AS LONG '              4 bytes  (file size)
145.         fomat AS STRING * 4 '       4 bytes  (WAVE)
146.         sub1 AS STRING * 4 '        4 bytes  (fmt )
147.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
148.         format AS INTEGER '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
149.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
150.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
151.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
152.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
153.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
154.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
155.         lenght AS LONG '            4 bytes  Data block size
156.     END TYPE '                     44 bytes  total
157.     DIM H16 AS head16
158.     ch = FREEFILE
159.  
160.     H16.chunk = "RIFF"
161.     H16.size = 44 + UBOUND(arr) * 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
162.  
163.     H16.fomat = "WAVE"
164.     H16.sub1 = "fmt "
165.     H16.subchunksize = 16
166.     H16.format = 1
167.     H16.channels = 2
168.     H16.rate = 44100
169.     H16.ByteRate = 44100 * 2 * 16 / 8
170.     H16.Block = 4
171.     H16.Bits = 16
172.     H16.subchunk2 = "data"
173.     H16.lenght = UBOUND(arr) * 4
174.     IF _FILEEXISTS(file$) THEN KILL file$
175.  
176.     OPEN file$ FOR BINARY AS #ch
177.     PUT #ch, , H16
178.     DIM LeftChannel AS INTEGER, RightChannel AS INTEGER
179.  
180.     FOR audiodata = 0 TO UBOUND(arr)
181.         LeftChannel = arr(audiodata).Left * 32768
182.         RightChannel = arr(audiodata).Right * 32768
183.  
184.         PUT #ch, , LeftChannel
185.         PUT #ch, , RightChannel
186.     NEXT
187.     CLOSE ch
188. END SUB
189.  

sound used as sound source in program:
 

1.wav

one from many possible outputs:
 

New_echo.wav

[Pete]

Great idea! Back in 1980's I had to mess around with the SOUND command, or whatever Atari and T.I, equivalent was around back then, probably SOUND, too, but anyway, it took some time to approximate sound distortions and mixes to make motor sounds, doors closing, etc. for adventure games. This could develop into a nice library of sounds for other developers to use.

Pete

[Petr]

Hi guys,

First I had to study how to get a sound of a specific frequency (it was very interesting and beneficial for me) and then I wrote this program. This is an attempt. The program reliably creates sound samples as they are created by the SOUND statement and then saves them to a WAV file. The use is a bit more complicated so far, this is my first program of this type (focused on the SOUND statement).

Code: QB64: [Select]

1. 'example how save frequency modulated sound created using SOUND statement to WAV file
2.  
3. TYPE snd
4.     Left AS SINGLE
5.     Right AS SINGLE
6. END TYPE
7.  
8. TYPE OtpSndHelper
9.     Offset_Start AS LONG
10.     Offset_End AS LONG
11. END TYPE
12.  
13. REDIM SHARED OTP(1) AS OtpSndHelper '   sound help array - contains start and end offsets values for every sound track
14. REDIM SHARED SND(0) AS snd '           "swap" - for creating 1 SOUND as RAW
15. REDIM SHARED OutputSound(44100) AS snd 'array, which contains all sounds (NOT OUTPUT WAV data!)
16. REDIM SHARED WAVE(0) AS snd '           real WAV output audio raw data
17.  
18. i = 0
19. DIM TotalSounds(19)
20. PRINT "Playing something using SOUND and SOUND2..."
21. L = 1
22. FOR bzzz = 1 TO 5
23.     FOR S = 100 TO 2000 STEP 100
24.         SOUND2 S, L
25.         SOUND S, L
26.         REDIM SND(0) AS snd
27.         SOUND2ARR S, L, SND()
28.         Current = ADDtoRAW(SND())
29.  
30.         position_in_bytes = 1 / 18 * L * i * 44100 '1/18 is value for sound leght (18 = 1 seconds), 10 is sound lenght used in this loop
31.         RAWCOPY Current, WAVE(), position_in_bytes, 1
32.         i = i + 1
33.     NEXT
34. NEXT
35. RealLenght WAVE(), (position_in_bytes + 1 / 18 * L * 44100) / _SNDRATE '1 second lenght sound using SOUND statement is> SOUND frequency, 18
36. PRINT "Writing file Test-SOUND.wav"
37. SAVESOUND16S WAVE(), "Test-SOUND.wav"
38. PRINT "Playing output..."
39. _SNDPLAYFILE ("Test-SOUND.wav")
40. END
41.  
42.  
43.  
44.  
45.  
46.  
47.  
48.  
49. SUB RealLenght (arr() AS snd, time AS SINGLE)
50.     Size = time * _SNDRATE
51.     REDIM _PRESERVE arr(Size) AS snd
52. END SUB
53.  
54.  
55. SUB RAWCOPY (handle, arr() AS snd, position AS LONG, Volume AS SINGLE)
56.     SoundLenghtInBytes = OTP(handle).Offset_End - OTP(handle).Offset_Start
57.     IF UBOUND(arr) < UBOUND(arr) + SoundLenghtInBytes + position THEN REDIM _PRESERVE arr(UBOUND(arr) + SoundLenghtInBytes + position) AS snd
58.     DIM rc AS LONG, OTPS AS LONG
59.     OTPS = OTP(handle).Offset_Start
60.     FOR rc = position TO position + SoundLenghtInBytes
61.  
62.         IF arr(rc).Left THEN OutLeft = (arr(rc).Left + (OutputSound(OTPS).Left) * Volume) / 1 ELSE OutLeft = OutputSound(OTPS).Left * Volume
63.         IF arr(rc).Right THEN OutRight = (arr(rc).Right + (OutputSound(OTPS).Right) * Volume) / 1 ELSE OutRight = OutputSound(OTPS).Right * Volume
64.  
65.         IF OutLeft > .9 THEN OutLeft = .9
66.         IF OutLeft < -.9 THEN OutLeft = -.9
67.  
68.         IF OutRight > .9 THEN OutRight = .9
69.         IF OutRight < -.9 THEN OutRight = -.9
70.  
71.         arr(rc).Left = OutLeft
72.         arr(rc).Right = OutRight
73.         OTPS = OTPS + 1
74.     NEXT rc
75. END SUB
76.  
77.  
78. FUNCTION ADDtoRAW (arr() AS snd) '                              Function add RAW samples to global RAW array
79.     size = UBOUND(arr)
80.     oss = UBOUND(OutputSound)
81.  
82.     OTP_Size = UBOUND(otp)
83.     OTP(OTP_Size).Offset_Start = UBOUND(outputsound) + 1
84.     REDIM _PRESERVE OutputSound(oss + size) AS snd
85.  
86.     FOR plll = 0 TO UBOUND(arr)
87.         OutputSound(oss + plll).Left = arr(plll).Left
88.         OutputSound(oss + plll).Right = arr(plll).Right
89.     NEXT plll
90.  
91.     OTP(OTP_Size).Offset_End = UBOUND(outputsound)
92.     REDIM _PRESERVE OTP(OTP_Size + 1) AS OtpSndHelper
93.  
94.     ADDtoRAW = OTP_Size
95. END FUNCTION
96.  
97.  
98.  
99. SUB SOUND2 (frequency AS INTEGER, Nlenght AS SINGLE)
100.     lenght = Nlenght * 1 / 18
101.     samples = _SNDRATE * lenght
102.     s = _PI / (_SNDRATE / frequency) * 2
103.  
104.     DO UNTIL plsam >= samples
105.         _SNDRAW SIN(u), COS(u)
106.         u = u + s
107.         IF ABS(s) = _SNDRATE / frequency THEN s = s * -1
108.         plsam = plsam + 1
109.     LOOP
110. END SUB
111.  
112. SUB SOUND2ARR (frequency AS INTEGER, Nlenght AS SINGLE, arr() AS snd)
113.     lenght = Nlenght * 1 / 18
114.     samples = _SNDRATE * lenght
115.     REDIM arr(samples) AS snd
116.     s = _PI / (_SNDRATE / frequency) * 2
117.  
118.     DO UNTIL plsam >= samples
119.         arr(plsam).Left = SIN(u) * .8
120.         arr(plsam).Right = COS(u) * .8
121.         REM        _SNDRAW SIN(u), COS(u)
122.         u = u + s
123.         IF ABS(s) = _SNDRATE / frequency THEN s = s * -1
124.         plsam = plsam + 1
125.     LOOP
126. END SUB
127.  
128. SUB SAVESOUND16S (arr() AS snd, file AS STRING)
129.  
130.     TYPE head16
131.         chunk AS STRING * 4 '       4 bytes  (RIFF)
132.         size AS LONG '              4 bytes  (file size)
133.         fomat AS STRING * 4 '       4 bytes  (WAVE)
134.         sub1 AS STRING * 4 '        4 bytes  (fmt )
135.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
136.         format AS INTEGER '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
137.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
138.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
139.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
140.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
141.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
142.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
143.         lenght AS LONG '            4 bytes  Data block size
144.     END TYPE '                     44 bytes  total
145.     DIM H16 AS head16
146.     ch = FREEFILE
147.  
148.     H16.chunk = "RIFF"
149.     H16.size = 44 + UBOUND(arr) * 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
150.  
151.     H16.fomat = "WAVE"
152.     H16.sub1 = "fmt "
153.     H16.subchunksize = 16
154.     H16.format = 1
155.     H16.channels = 2
156.     H16.rate = 44100
157.     H16.ByteRate = 44100 * 2 * 16 / 8
158.     H16.Block = 4
159.     H16.Bits = 16
160.     H16.subchunk2 = "data"
161.     H16.lenght = UBOUND(arr) * 4
162.     IF _FILEEXISTS(file$) THEN KILL file$
163.  
164.     OPEN file$ FOR BINARY AS #ch
165.     PUT #ch, , H16
166.     DIM LeftChannel AS INTEGER, RightChannel AS INTEGER
167.  
168.     FOR audiodata = 0 TO UBOUND(arr)
169.         LeftChannel = arr(audiodata).Left * 32768
170.         RightChannel = arr(audiodata).Right * 32768
171.  
172.         PUT #ch, , LeftChannel
173.         PUT #ch, , RightChannel
174.     NEXT
175.     CLOSE ch
176. END SUB
177.  
178.  

Edit: Source code repaired, unexpected tone lenght change is corrected and now works right.

[johnno56]

Nicely done. I tested the output file using VLC and the Media Play and Audacity, on my Linux machine, but I have to say the the sound played much better through QB64. The other applications lacked the "echo" effect that QB64 seems to produce. Looking forward to any other sounds you may wish to produce. Cool.

[Petr]

Thank you, Johnno56. Echo in previous source is unexpected effect, because is playing SOUND statement, SOUND2 SUB and created WAV file in one moment. This then do echo effect. For real echo effect to output file, you can try this next upgraded source code. Echo can be set on row 37 in source code, it is ECHO (source array AS SND, ouput array AS SND, time, repeat number)

This source code write this sound + echo to WAV file:

Code: QB64: [Select]

1. 'example how save frequency modulated sound created using SOUND statement to WAV file
2.  
3. TYPE snd
4.     Left AS SINGLE
5.     Right AS SINGLE
6. END TYPE
7.  
8. TYPE OtpSndHelper
9.     Offset_Start AS LONG
10.     Offset_End AS LONG
11. END TYPE
12.  
13. REDIM SHARED OTP(0) AS OtpSndHelper '   sound help array - contains start and end offsets values for every sound track
14. REDIM SHARED SND(0) AS snd '           "swap" - for creating 1 SOUND as RAW
15. REDIM SHARED OutputSound(44100) AS snd 'array, which contains all sounds (NOT OUTPUT WAV data!)
16. REDIM SHARED WAVE(0) AS snd '           real WAV output audio raw data
17.  
18. i = 0
19. DIM TotalSounds(19)
20. PRINT "Playing something using SOUND and SOUND2..."
21. L = 1
22. FOR bzzz = 1 TO 5
23.     FOR S = 100 TO 2000 STEP 100
24.         REM  SOUND2 S, L
25.         SOUND S, L
26.         REDIM SND(0) AS snd
27.         SOUND2ARR S, L, SND()
28.         Current = ADDtoRAW(SND())
29.         position_in_bytes = 1 / 18 * L * i * 44100 - prunik '1/18 is value for sound leght (18 = 1 seconds), L is sound lenght used in this loop
30.         RAWCOPY Current, WAVE(), position_in_bytes, 1
31.         i = i + 1
32.         prunik = prunik + 100
33.     NEXT
34. NEXT
35. RealLenght WAVE(), (position_in_bytes + 1 / 18 * L * 44100) / _SNDRATE '1 second lenght sound using SOUND statement is> SOUND frequency, 18
36. REDIM NewWave(0) AS snd
37. Echo WAVE(), NewWave(), .1, 6
38. ERASE WAVE
39. PRINT "Writing file Test-SOUND.wav"
40.  
41.  
42. SAVESOUND16S NewWave(), "Test-SOUND.wav"
43. PRINT "Playing output..."
44. _SNDPLAYFILE ("Test-SOUND.wav")
45. END
46.  
47.  
48. FUNCTION RawSize& (handle)
49.     RawSize = OTP(handle).Offset_End - OTP(handle).Offset_Start
50. END FUNCTION
51.  
52.  
53.  
54.  
55.  
56. SUB Echo (arr() AS snd, arr2() AS snd, time, p)
57.     Newsize = 44100 * time * p + UBOUND(arr)
58.     REDIM _PRESERVE arr2(Newsize) AS snd
59.     FOR e = 1 TO p 'echoes number
60.         Start& = 44100 * e * time
61.         COPYSND arr(), arr2(), Start&
62.     NEXT e
63. END SUB
64.  
65. SUB COPYSND (source() AS snd, dest() AS snd, startindex AS LONG)
66.     DIM c AS LONG, d AS LONG
67.     c = LBOUND(source)
68.     FOR d = startindex TO startindex + UBOUND(source)
69.         IF dest(d).Left THEN dest(d).Left = (dest(d).Left + source(c).Left) / 2 ELSE dest(d).Left = source(c).Left
70.         IF dest(d).Right THEN dest(d).Right = (dest(d).Right + source(c).Right) / 2 ELSE dest(d).Right = source(c).Right
71.         IF dest(d).Left > 1 THEN dest(d).Left = 1
72.         IF dest(d).Left < -1 THEN dest(d).Left = -1
73.  
74.         IF dest(d).Right > 1 THEN dest(d).Right = 1
75.         IF dest(d).Right < -1 THEN dest(d).Right = -1
76.         c = c + 1
77.     NEXT d
78. END SUB
79.  
80.  
81.  
82.  
83.  
84.  
85. SUB RealLenght (arr() AS snd, time AS SINGLE)
86.     Size = time * _SNDRATE
87.     REDIM _PRESERVE arr(Size) AS snd
88. END SUB
89.  
90.  
91. SUB RAWCOPY (handle, arr() AS snd, position AS LONG, Volume AS SINGLE)
92.     SoundLenghtInBytes = OTP(handle).Offset_End - OTP(handle).Offset_Start
93.     IF UBOUND(arr) < UBOUND(arr) + SoundLenghtInBytes + position THEN REDIM _PRESERVE arr(UBOUND(arr) + SoundLenghtInBytes + position) AS snd
94.     DIM rc AS LONG, OTPS AS LONG
95.     OTPS = OTP(handle).Offset_Start
96.     FOR rc = position TO position + SoundLenghtInBytes
97.  
98.         IF arr(rc).Left THEN OutLeft = (arr(rc).Left + (OutputSound(OTPS).Left) * Volume) / 1 ELSE OutLeft = OutputSound(OTPS).Left * Volume
99.         IF arr(rc).Right THEN OutRight = (arr(rc).Right + (OutputSound(OTPS).Right) * Volume) / 1 ELSE OutRight = OutputSound(OTPS).Right * Volume
100.  
101.         IF OutLeft > .9 THEN OutLeft = .9
102.         IF OutLeft < -.9 THEN OutLeft = -.9
103.  
104.         IF OutRight > .9 THEN OutRight = .9
105.         IF OutRight < -.9 THEN OutRight = -.9
106.  
107.         arr(rc).Left = OutLeft
108.         arr(rc).Right = OutRight
109.         OTPS = OTPS + 1
110.     NEXT rc
111. END SUB
112.  
113.  
114. FUNCTION ADDtoRAW (arr() AS snd) '                              Function add RAW samples to global RAW array
115.     size = UBOUND(arr)
116.     oss = UBOUND(OutputSound)
117.  
118.     OTP_Size = UBOUND(otp)
119.     OTP(OTP_Size).Offset_Start = UBOUND(outputsound) + 1
120.     REDIM _PRESERVE OutputSound(oss + size) AS snd
121.  
122.     FOR plll = 0 TO UBOUND(arr)
123.         OutputSound(oss + plll).Left = arr(plll).Left
124.         OutputSound(oss + plll).Right = arr(plll).Right
125.     NEXT plll
126.  
127.     OTP(OTP_Size).Offset_End = UBOUND(outputsound)
128.     REDIM _PRESERVE OTP(OTP_Size + 1) AS OtpSndHelper
129.  
130.     ADDtoRAW = OTP_Size
131. END FUNCTION
132.  
133.  
134.  
135. SUB SOUND2 (frequency AS INTEGER, Nlenght AS SINGLE)
136.     lenght = Nlenght / 18
137.     DIM SAMPLES AS LONG, plsam AS LONG
138.     SAMPLES = (44100 * lenght) - 100
139.     s = _PI / (44100 / frequency) * 2
140.  
141.     DO UNTIL plsam >= SAMPLES
142.         _SNDRAW SIN(u), COS(u)
143.         u = u + s
144.         IF ABS(s) >= 44100 / frequency THEN s = s * -1
145.         plsam = plsam + 1
146.     LOOP
147. END SUB
148.  
149. SUB SOUND2ARR (frequency AS INTEGER, Nlenght AS SINGLE, arr() AS snd)
150.     lenght = Nlenght / 18
151.     DIM SAMPLES AS LONG, plsam AS LONG
152.     SAMPLES = 44100 * lenght
153.     REDIM arr(SAMPLES) AS snd
154.     S = _PI / (44100 / frequency) * 2
155.  
156.     DO UNTIL plsam >= SAMPLES
157.         arr(plsam).Left = SIN(u)
158.         arr(plsam).Right = SIN(u)
159.         REM        _SNDRAW SIN(u), COS(u)
160.         u = u + S
161.         IF ABS(S) >= _SNDRATE / frequency THEN S = S * -1
162.         plsam = plsam + 1
163.     LOOP
164. END SUB
165.  
166. SUB SAVESOUND16S (arr() AS snd, file AS STRING)
167.  
168.     TYPE head16
169.         chunk AS STRING * 4 '       4 bytes  (RIFF)
170.         size AS LONG '              4 bytes  (file size)
171.         fomat AS STRING * 4 '       4 bytes  (WAVE)
172.         sub1 AS STRING * 4 '        4 bytes  (fmt )
173.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
174.         format AS INTEGER '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
175.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
176.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
177.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
178.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
179.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
180.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
181.         lenght AS LONG '            4 bytes  Data block size
182.     END TYPE '                     44 bytes  total
183.     DIM H16 AS head16
184.     ch = FREEFILE
185.  
186.     H16.chunk = "RIFF"
187.     H16.size = 44 + UBOUND(arr) * 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
188.  
189.     H16.fomat = "WAVE"
190.     H16.sub1 = "fmt "
191.     H16.subchunksize = 16
192.     H16.format = 1
193.     H16.channels = 2
194.     H16.rate = 44100
195.     H16.ByteRate = 44100 * 2 * 16 / 8
196.     H16.Block = 4
197.     H16.Bits = 16
198.     H16.subchunk2 = "data"
199.     H16.lenght = UBOUND(arr) * 4
200.     IF _FILEEXISTS(file$) THEN KILL file$
201.  
202.     OPEN file$ FOR BINARY AS #ch
203.     PUT #ch, , H16
204.     DIM LeftChannel AS INTEGER, RightChannel AS INTEGER
205.  
206.     FOR audiodata = 0 TO UBOUND(arr)
207.         LeftChannel = arr(audiodata).Left * 32768
208.         RightChannel = arr(audiodata).Right * 32768
209.  
210.         PUT #ch, , LeftChannel
211.         PUT #ch, , RightChannel
212.     NEXT
213.     CLOSE ch
214. END SUB
215.  

[Petr]

For those who want to try some effects, I'm adding a much faster version of the previous program here. This version also fixes a memory leak that was in previous versions. For comparison, try to generate the same number of repetitions of some tones with this and the previous version. The difference in processing speed is considerable.

Code: QB64: [Select]

1. 'example how save frequency modulated sound created using SOUND statement to WAV file - SPEED UP version
2.  
3. TYPE snd
4.     Left AS SINGLE
5.     Right AS SINGLE
6. END TYPE
7.  
8. TYPE OtpSndHelper
9.     Offset_Start AS LONG
10.     Offset_End AS LONG
11. END TYPE
12.  
13. REDIM SHARED OTP(0) AS OtpSndHelper '   sound help array - contains start and end offsets values for every sound track
14. REDIM SHARED SND(0) AS snd '           "swap" - for creating 1 SOUND as RAW
15. REDIM SHARED OutputSound(44100) AS snd 'array, which contains all sounds (NOT OUTPUT WAV data!)
16. REDIM SHARED WAVE(0) AS snd '           real WAV output audio raw data
17.  
18. i = 0
19.  
20. PRINT "Creating some tone..."
21. L = .25 'tone lenght
22. DIM bzzz AS LONG, s AS LONG, i AS _UNSIGNED LONG
23.  
24.  
25.  
26.  
27. FOR bzzz = 1 TO 5 'repetition
28.     PRINT "repetition:"; bzzz
29.     FOR s = 100 TO 2000 STEP 10 'tone frequency
30.  
31.         REM  SOUND2 S, L
32.         REM   SOUND S, L
33.  
34.         REDIM SND(0) AS snd
35.         SOUND2ARR s, L, SND()
36.         Current& = ADDtoRAW(SND())
37.         position_in_bytes& = 1 / 18 * L * i& * 44100 - prunik '1/18 is value for sound leght (18 = 1 seconds), L is sound lenght used in this loop
38.         RAWCOPY Current&, WAVE(), position_in_bytes&, 1
39.         i& = i& + 1
40.         prunik = prunik + 100
41.     NEXT
42. NEXT
43. RealLenght WAVE(), (position_in_bytes& + 1 / 18 * L * 44100) / _SNDRATE '1 second lenght sound using SOUND statement is> SOUND frequency, 18
44. REDIM NewWave(0) AS snd
45. PRINT "add echo..."
46. Echo WAVE(), NewWave(), .1, 6
47. ERASE WAVE
48. PRINT "Writing file Test-SOUND.wav"
49. PRINT UBOUND(outputsound)
50. ERASE OutputSound
51.  
52.  
53. SAVESOUND16S NewWave(), "Test-SOUND.wav"
54. PRINT "Playing output..."
55. _SNDPLAYFILE ("Test-SOUND.wav")
56. END
57.  
58. SUB Echo (arr() AS snd, arr2() AS snd, time, p)
59.     Newsize = 44100 * time * p + UBOUND(arr)
60.     REDIM _PRESERVE arr2(Newsize) AS snd
61.     FOR e = 1 TO p 'echoes number
62.         Start& = 44100 * e * time
63.         COPYSND arr(), arr2(), Start&
64.     NEXT e
65. END SUB
66.  
67. SUB COPYSND (source() AS snd, dest() AS snd, startindex AS LONG)
68.  
69.     DIM c AS LONG, d AS LONG
70.     c = LBOUND(source)
71.     d = startindex
72.  
73.     DO UNTIL d = startindex + UBOUND(source)
74.         IF dest(d).Left THEN dest(d).Left = (dest(d).Left + source(c).Left) / 2 ELSE dest(d).Left = source(c).Left
75.         IF dest(d).Right THEN dest(d).Right = (dest(d).Right + source(c).Right) / 2 ELSE dest(d).Right = source(c).Right
76.         IF dest(d).Left > 1 THEN dest(d).Left = 1
77.         IF dest(d).Left < -1 THEN dest(d).Left = -1
78.  
79.         IF dest(d).Right > 1 THEN dest(d).Right = 1
80.         IF dest(d).Right < -1 THEN dest(d).Right = -1
81.         c = c + 1
82.         d = d + 1
83.     LOOP
84. END SUB
85.  
86.  
87.  
88.  
89.  
90.  
91. SUB RealLenght (arr() AS snd, time AS SINGLE)
92.     Size = time * _SNDRATE
93.     REDIM _PRESERVE arr(Size) AS snd
94. END SUB
95.  
96.  
97. SUB RAWCOPY (handle, arr() AS snd, position AS LONG, Volume AS SINGLE) 'Repaired memory leak -> sub speed is now 20x higher
98.     REDIM SoundLenghtInBytes AS LONG
99.     REDIM rc AS LONG, OTPS AS _UNSIGNED LONG
100.     REDIM OutLeft AS SINGLE, OutRight AS SINGLE
101.  
102.  
103.     SoundLenghtInBytes = OTP(handle).Offset_End - OTP(handle).Offset_Start
104.  
105.  
106.     OldLen = UBOUND(arr)
107.     NewLen = position + SoundLenghtInBytes
108.     REDIM _PRESERVE arr(NewLen) AS snd
109.  
110.     OTPS = OTP(handle).Offset_Start
111.     rc = position
112.  
113.     DO UNTIL rc = position + SoundLenghtInBytes
114.  
115.         IF arr(rc).Left THEN OutLeft = (arr(rc).Left + (OutputSound(OTPS).Left) * Volume) ELSE OutLeft = OutputSound(OTPS).Left * Volume
116.         IF arr(rc).Right THEN OutRight = (arr(rc).Right + (OutputSound(OTPS).Right) * Volume) ELSE OutRight = OutputSound(OTPS).Right * Volume
117.  
118.         IF OutLeft > .9 THEN OutLeft = .9
119.         IF OutLeft < -.9 THEN OutLeft = -.9
120.  
121.         IF OutRight > .9 THEN OutRight = .9
122.         IF OutRight < -.9 THEN OutRight = -.9
123.  
124.         arr(rc).Left = OutLeft
125.         arr(rc).Right = OutRight
126.         OTPS = OTPS + 1
127.         rc = rc + 1
128.     LOOP
129. END SUB
130.  
131.  
132. FUNCTION ADDtoRAW& (arr() AS snd) '                              Function add RAW samples to global RAW array
133.     size = UBOUND(arr)
134.     oss = UBOUND(OutputSound)
135.     REDIM OTP_size AS LONG, outputsound AS LONG, plll AS LONG
136.     OTP_size = UBOUND(OTP)
137.     OTP(OTP_size).Offset_Start = UBOUND(outputsound) + 1
138.     REDIM _PRESERVE OutputSound(oss + size) AS snd
139.  
140.     FOR plll = 0 TO UBOUND(arr)
141.         OutputSound(oss + plll).Left = arr(plll).Left
142.         OutputSound(oss + plll).Right = arr(plll).Right
143.     NEXT plll
144.  
145.     OTP(OTP_size).Offset_End = UBOUND(outputsound)
146.     REDIM _PRESERVE OTP(OTP_size + 1) AS OtpSndHelper
147.  
148.     ADDtoRAW& = OTP_size
149. END FUNCTION
150.  
151.  
152.  
153. SUB SOUND2 (frequency AS INTEGER, Nlenght AS SINGLE)
154.     lenght = Nlenght / 18
155.     DIM SAMPLES AS LONG, plsam AS LONG
156.     SAMPLES = (44100 * lenght) - 100
157.     s = _PI / (44100 / frequency) * 2
158.  
159.     DO UNTIL plsam >= SAMPLES
160.         _SNDRAW SIN(u), COS(u)
161.         u = u + s
162.         IF ABS(s) >= 44100 / frequency THEN s = s * -1
163.         plsam = plsam + 1
164.     LOOP
165. END SUB
166.  
167. SUB SOUND2ARR (frequency AS INTEGER, Nlenght AS SINGLE, arr() AS snd)
168.     lenght = Nlenght / 18
169.     DIM SAMPLES AS LONG, plsam AS LONG
170.     SAMPLES = 44100 * lenght
171.     REDIM arr(SAMPLES) AS snd
172.     S = _PI / (44100 / frequency) * 2
173.  
174.     DO UNTIL plsam >= SAMPLES
175.         arr(plsam).Left = SIN(u)
176.         arr(plsam).Right = SIN(u)
177.         REM        _SNDRAW SIN(u), COS(u)
178.         u = u + S
179.         IF ABS(S) >= _SNDRATE / frequency THEN S = S * -1
180.         plsam = plsam + 1
181.     LOOP
182. END SUB
183.  
184. SUB SAVESOUND16S (arr() AS snd, file AS STRING) 'speed upgraded version (now much faster), first SINGLE values are recalculated as INTEGERs and THEN writed at once to file.
185.  
186.     TYPE head16
187.         chunk AS STRING * 4 '       4 bytes  (RIFF)
188.         size AS LONG '              4 bytes  (file size)
189.         fomat AS STRING * 4 '       4 bytes  (WAVE)
190.         sub1 AS STRING * 4 '        4 bytes  (fmt )
191.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
192.         format AS INTEGER '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
193.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
194.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
195.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
196.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
197.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
198.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
199.         lenght AS LONG '            4 bytes  Data block size
200.     END TYPE '                     44 bytes  total
201.     DIM H16 AS head16
202.     ch = FREEFILE
203.  
204.     H16.chunk = "RIFF"
205.     H16.size = 44 + UBOUND(arr) * 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
206.  
207.     H16.fomat = "WAVE"
208.     H16.sub1 = "fmt "
209.     H16.subchunksize = 16
210.     H16.format = 1
211.     H16.channels = 2
212.     H16.rate = 44100
213.     H16.ByteRate = 44100 * 2 * 16 / 8
214.     H16.Block = 4
215.     H16.Bits = 16
216.     H16.subchunk2 = "data"
217.     H16.lenght = UBOUND(arr) * 4
218.     IF _FILEEXISTS(file$) THEN KILL file$
219.  
220.     OPEN file$ FOR BINARY AS #ch
221.     PUT #ch, , H16
222.  
223.     TYPE WavAudio
224.         LeftChannel AS INTEGER
225.         RightChannel AS INTEGER
226.     END TYPE
227.     DIM WavAudio(UBOUND(arr)) AS WavAudio, AudioData AS LONG
228.  
229.     DO UNTIL AudioData = UBOUND(arr)
230.         WavAudio(AudioData).LeftChannel = arr(AudioData).Left * 32768
231.         WavAudio(AudioData).RightChannel = arr(AudioData).Right * 32768
232.         AudioData = AudioData + 1
233.     LOOP
234.  
235.     PUT #ch, , WavAudio()
236.     _DELAY .1
237.     ERASE WavAudio
238.     CLOSE ch
239. END SUB
240.  

[_vince]

I've managed to work in my routines as an example, it takes a few seconds to create the file

Code: QB64: [Select]

1. TYPE Snd
2.     Left AS SINGLE
3.     Right AS SINGLE
4. END TYPE
5. REDIM SHARED OutputSound(-1) AS Snd
6.  
7. TYPE OtpSndHelper
8.     Offset_Start AS LONG
9.     Offset_End AS LONG
10. END TYPE
11. REDIM SHARED OTP(1) AS OtpSndHelper
12. '----------------------------------------
13. dim shared pi as double
14. pi = 4*atn(1)
15.  
16.  
17.  
18. handle = WAVtoRAW("1.wav") ' write sound content as binary data to array OutputSound
19. REDIM echo(0) AS Snd
20. AddEcho handle, 0, 1, echo() '  create new sound from old sound using echo in with time .1 seconds and 5 echoes
21.  
22.  
23. 'REDIM Longer(0) AS Snd
24. 'SNDARRCOPY echo(), 2, Longer() ' copy done sound effect as 2 sounds consecutively
25. 'ERASE echo
26.  
27.  
28.  
29.  
30. sw = 1024
31. sh = 768
32. screen _newimage(sw,sh,32)
33. m = ubound(echo)
34.  
35. n = 65536
36. dim temp(n - 1)
37. dim leftx(n - 1), rightx(n - 1)
38. dim leftxx_r(n - 1), leftxx_i(n - 1)
39. dim rightxx_r(n - 1), rightxx_i(n - 1)
40.  
41. for i = 0 to ubound(echo)
42.         leftx(i) = echo(i).Left
43.         rightx(i) = echo(i).Right
44. next
45.  
46. pset (0, sh/6)
47. for x=0 to sw-1
48.         line -(x, sh/6 - 100*leftx(x*n/sw))
49. next
50.  
51. pset (0, 2*sh/6)
52. for x=0 to sw-1
53.         line -(x, 2*sh/6 - 100*rightx(x*n/sw))
54. next
55.  
56. rfft leftxx_r(), leftxx_i(), leftx(), n
57. rfft rightxx_r(), rightxx_i(), rightx(), n
58.  
59. pset (0, 4*sh/6)
60. for x=0 to sw-1
61.         line -(x, 4*sh/6 - sqr(leftxx_r(x*n/2/sw)^2 +  leftxx_i(x*n/2/sw)^2))
62. next
63.  
64. pset (0, 5*sh/6)
65. for x=0 to sw-1
66.         line -(x, 5*sh/6 - sqr(rightxx_r(x*n/2/sw)^2 +  rightxx_i(x*n/2/sw)^2))
67. next
68.  
69.  
70. for i=1 to 40*n/sw 'to n/2 - 1
71.         leftxx_r(i) = 0
72.         leftxx_i(i) = 0
73.         leftxx_r(n - i) = 0
74.         leftxx_i(n - i) = 0
75.  
76.         rightxx_r(i) = 0
77.         rightxx_i(i) = 0
78.         rightxx_r(n - i) = 0
79.         rightxx_i(n - i) = 0
80. next
81. pset (0, 4*sh/6),_rgb(0,255,0)
82. for x=0 to sw-1
83.         line -(x, 4*sh/6 - sqr(leftxx_r(x*n/2/sw)^2 +  leftxx_i(x*n/2/sw)^2)),_rgb(0,255,0)
84. next
85.  
86. pset (0, 5*sh/6),_rgb(0,255,0)
87. for x=0 to sw-1
88.         line -(x, 5*sh/6 - sqr(rightxx_r(x*n/2/sw)^2 +  rightxx_i(x*n/2/sw)^2)),_rgb(0,255,0)
89. next
90.  
91. 'line (100*
92.  
93.  
94. 'inverse
95. for i=0 to n-1
96.         leftxx_i(i) = -leftxx_i(i)
97.         rightxx_i(i) = -rightxx_i(i)
98. next
99.  
100. fft leftx(), temp(), leftxx_r(), leftxx_i(), n
101. fft rightx(), temp(), rightxx_r(), rightxx_i(), n
102.  
103. for i=0 to n-1
104.         leftx(i) = leftx(i)/n
105.         rightx(i) = rightx(i)/n
106. next
107.  
108. for i = 0 to ubound(echo)
109.         echo(i).Left = leftx(i)
110.         echo(i).Right = rightx(i)
111. next
112.  
113. SAVESOUND16S echo(), "high_freq.wav" ' save new sound as file New_echo.wav
114.  
115. locate 1,1: ? "high pass done"
116. sleep
117. cls
118. handle = WAVtoRAW("1.wav") ' write sound content as binary data to array OutputSound
119. REDIM echo(0) AS Snd
120. AddEcho handle, 0, 1, echo() '  create new sound from old sound using echo in with time .1 seconds and 5 echoes
121. for i = 0 to ubound(echo)
122.         leftx(i) = echo(i).Left
123.         rightx(i) = echo(i).Right
124. next
125.  
126. pset (0, sh/6)
127. for x=0 to sw-1
128.         line -(x, sh/6 - 100*leftx(x*n/sw))
129. next
130.  
131. pset (0, 2*sh/6)
132. for x=0 to sw-1
133.         line -(x, 2*sh/6 - 100*rightx(x*n/sw))
134. next
135.  
136. rfft leftxx_r(), leftxx_i(), leftx(), n
137. rfft rightxx_r(), rightxx_i(), rightx(), n
138.  
139. pset (0, 4*sh/6)
140. for x=0 to sw-1
141.         line -(x, 4*sh/6 - sqr(leftxx_r(x*n/2/sw)^2 +  leftxx_i(x*n/2/sw)^2))
142. next
143.  
144. pset (0, 5*sh/6)
145. for x=0 to sw-1
146.         line -(x, 5*sh/6 - sqr(rightxx_r(x*n/2/sw)^2 +  rightxx_i(x*n/2/sw)^2))
147. next
148.  
149.  
150. for i=40*n/sw to n/2 - 1
151.         leftxx_r(i) = 0
152.         leftxx_i(i) = 0
153.         leftxx_r(n - i) = 0
154.         leftxx_i(n - i) = 0
155.  
156.         rightxx_r(i) = 0
157.         rightxx_i(i) = 0
158.         rightxx_r(n - i) = 0
159.         rightxx_i(n - i) = 0
160. next
161. pset (0, 4*sh/6),_rgb(0,255,0)
162. for x=0 to sw-1
163.         line -(x, 4*sh/6 - sqr(leftxx_r(x*n/2/sw)^2 +  leftxx_i(x*n/2/sw)^2)),_rgb(0,255,0)
164. next
165.  
166. pset (0, 5*sh/6),_rgb(0,255,0)
167. for x=0 to sw-1
168.         line -(x, 5*sh/6 - sqr(rightxx_r(x*n/2/sw)^2 +  rightxx_i(x*n/2/sw)^2)),_rgb(0,255,0)
169. next
170.  
171. 'line (100*
172.  
173.  
174. 'inverse
175. for i=0 to n-1
176.         leftxx_i(i) = -leftxx_i(i)
177.         rightxx_i(i) = -rightxx_i(i)
178. next
179.  
180. fft leftx(), temp(), leftxx_r(), leftxx_i(), n
181. fft rightx(), temp(), rightxx_r(), rightxx_i(), n
182.  
183. for i=0 to n-1
184.         leftx(i) = leftx(i)/n
185.         rightx(i) = rightx(i)/n
186. next
187.  
188. for i = 0 to ubound(echo)
189.         echo(i).Left = leftx(i)
190.         echo(i).Right = rightx(i)
191. next
192.  
193. locate 1,1: ? "low pass done"
194.  
195. SAVESOUND16S echo(), "low_freq.wav" ' save new sound as file New_echo.wav
196. '_SNDPLAYFILE "new_echo.wav" 'play it
197. 'ERASE longer
198.  
199. sleep
200. system
201.  
202. sub fft(xx_r(), xx_i(), x_r(), x_i(), n)
203.         dim w_r as double, w_i as double, wm_r as double, wm_i as double
204.         dim u_r as double, u_i as double, v_r as double, v_i as double
205.  
206.         log2n = log(n)/log(2)
207.  
208.         'bit rev copy
209.         for i=0 to n - 1
210.                 rev = 0
211.                 for j=0 to log2n - 1
212.                         if i and (2^j) then rev = rev + (2^(log2n - 1 - j))
213.                 next
214.  
215.                 xx_r(i) = x_r(rev)
216.                 xx_i(i) = x_i(rev)
217.         next
218.  
219.  
220.         for i=1 to log2n
221.                 m = 2^i
222.                 wm_r = cos(-2*pi/m)
223.                 wm_i = sin(-2*pi/m)
224.  
225.                 for j=0 to n - 1 step m
226.                         w_r = 1
227.                         w_i = 0
228.  
229.                         for k=0 to m/2 - 1
230.                                 p = j + k
231.                                 q = p + (m \ 2)
232.  
233.                                 u_r = w_r*xx_r(q) - w_i*xx_i(q)
234.                                 u_i = w_r*xx_i(q) + w_i*xx_r(q)
235.                                 v_r = xx_r(p)
236.                                 v_i = xx_i(p)
237.  
238.                                 xx_r(p) = v_r + u_r
239.                                 xx_i(p) = v_i + u_i
240.                                 xx_r(q) = v_r - u_r
241.                                 xx_i(q) = v_i - u_i
242.  
243.                                 u_r = w_r
244.                                 u_i = w_i
245.                                 w_r = u_r*wm_r - u_i*wm_i
246.                                 w_i = u_r*wm_i + u_i*wm_r
247.                         next
248.                 next
249.         next
250. end sub
251.  
252. sub rfft(xx_r(), xx_i(), x_r(), n)
253.         dim w_r as double, w_i as double, wm_r as double, wm_i as double
254.         dim u_r as double, u_i as double, v_r as double, v_i as double
255.  
256.         log2n = log(n/2)/log(2)
257.  
258.         for i=0 to n/2 - 1
259.                 rev = 0
260.                 for j=0 to log2n - 1
261.                         if i and (2^j) then rev = rev + (2^(log2n - 1 - j))
262.                 next
263.  
264.                 xx_r(i) = x_r(2*rev)
265.                 xx_i(i) = x_r(2*rev + 1)
266.         next
267.  
268.         for i=1 to log2n
269.                 m = 2^i
270.                 wm_r = cos(-2*pi/m)
271.                 wm_i = sin(-2*pi/m)
272.  
273.                 for j=0 to n/2 - 1 step m
274.                         w_r = 1
275.                         w_i = 0
276.  
277.                         for k=0 to m/2 - 1
278.                                 p = j + k
279.                                 q = p + (m \ 2)
280.  
281.                                 u_r = w_r*xx_r(q) - w_i*xx_i(q)
282.                                 u_i = w_r*xx_i(q) + w_i*xx_r(q)
283.                                 v_r = xx_r(p)
284.                                 v_i = xx_i(p)
285.  
286.                                 xx_r(p) = v_r + u_r
287.                                 xx_i(p) = v_i + u_i
288.                                 xx_r(q) = v_r - u_r
289.                                 xx_i(q) = v_i - u_i
290.  
291.                                 u_r = w_r
292.                                 u_i = w_i
293.                                 w_r = u_r*wm_r - u_i*wm_i
294.                                 w_i = u_r*wm_i + u_i*wm_r
295.                         next
296.                 next
297.         next
298.  
299.         xx_r(n/2) = xx_r(0)
300.         xx_i(n/2) = xx_i(0)
301.  
302.         for i=1 to n/2 - 1
303.                 xx_r(n/2 + i) = xx_r(n/2 - i)
304.                 xx_i(n/2 + i) = xx_i(n/2 - i)
305.         next
306.  
307.         dim xpr as double, xpi as double
308.         dim xmr as double, xmi as double
309.  
310.         for i=0 to n/2 - 1
311.                 xpr = (xx_r(i) + xx_r(n/2 + i)) / 2
312.                 xpi = (xx_i(i) + xx_i(n/2 + i)) / 2
313.  
314.                 xmr = (xx_r(i) - xx_r(n/2 + i)) / 2
315.                 xmi = (xx_i(i) - xx_i(n/2 + i)) / 2
316.  
317.                 xx_r(i) = xpr + xpi*cos(2*pi*i/n) - xmr*sin(2*pi*i/n)
318.                 xx_i(i) = xmi - xpi*sin(2*pi*i/n) - xmr*cos(2*pi*i/n)
319.         next
320.  
321.         'symmetry, complex conj
322.         for i=0 to n/2 - 1
323.                 xx_r(n/2 + i) = xx_r(n/2 - 1 - i)
324.                 xx_i(n/2 + i) =-xx_i(n/2 - 1 - i)
325.         next
326. end sub
327.  
328.  
329. SUB SNDARRCOPY (source() AS Snd, much AS INTEGER, dest() AS Snd)
330.     u = UBOUND(source)
331.     REDIM dest(u * much) AS Snd
332.     FOR c& = 1 TO much
333.         FOR d& = 1 TO u
334.             dest(i&) = source(d&)
335.             i& = i& + 1
336.     NEXT d&, c&
337. END SUB
338.  
339.  
340.  
341.  
342. 'delka echa v sekundach, pocet ozven
343. SUB AddEcho (handle, lenght AS SINGLE, echoes AS INTEGER, arr() AS Snd)
344.     Re = RawSize(handle)
345.     BLen& = 44100 * lenght
346.  
347.     size = Re + (BLen& * echoes)
348.     REDIM arr(size) AS Snd
349.     devol = 1 / echoes
350.     vol = 1
351.     FOR e = 1 TO echoes
352.         FOR c = OTP(handle).Offset_Start TO OTP(handle).Offset_End
353.             arr(i& + s).Left = OutputSound(c).Left * vol + arr(i& + s).Left
354.             arr(i& + s).Right = OutputSound(c).Right * vol + arr(i& + s).Right
355.             IF arr(i&).Left > .9 THEN arr(i&).Left = .9
356.             IF arr(i&).Left < -.9 THEN arr(i&).Left = -.9
357.             IF arr(i&).Right > .9 THEN arr(i&).Right = .9
358.             IF arr(i&).Right < -.9 THEN arr(i&).Right = -.9
359.             i& = i& + 1
360.         NEXT c
361.         s& = s& + BLen&
362.         i& = s&
363.         vol = vol - devol
364.     NEXT e
365. END SUB
366.  
367. FUNCTION RawSize& (handle)
368.     RawSize = OTP(handle).Offset_End - OTP(handle).Offset_Start
369. END FUNCTION
370.  
371.  
372. FUNCTION WAVtoRAW (file$) '                              Function load WAV file (this just 16bit, stereo format) and load it to array as RAW.
373.     TYPE head
374.         chunk AS STRING * 4 '       4 bytes  (RIFF)
375.         size AS LONG '              4 bytes  (?E??)
376.         fomat AS STRING * 4 '       4 bytes  (WAVE)
377.         sub1 AS STRING * 4 '        4 bytes  (fmt )
378.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
379.         format AS STRING * 2 '      2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
380.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
381.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
382.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
383.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
384.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
385.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
386.     END TYPE '                     40 bytes  total
387.     DIM H AS head
388.     ch = FREEFILE
389.  
390.     IF _FILEEXISTS(file$) THEN OPEN file$ FOR BINARY AS #ch ELSE PRINT file$; " not found": SLEEP 2: SYSTEM
391.     GET #ch, , H
392.  
393.     block = H.Block
394.     RATE = H.rate
395.     chan = H.channels
396.     bits = H.Bits
397.  
398.     SEEK #ch, Find_data_area(file$)
399.  
400.     OTP_Size = UBOUND(otp)
401.     OTP(OTP_Size).Offset_Start = UBOUND(outputsound) + 1
402.  
403.     DO WHILE NOT EOF(ch)
404.         IF bits = 16 AND chan = 2 THEN
405.             REDIM lefi AS INTEGER, righi AS INTEGER
406.             GET #ch, , lefi
407.             GET #ch, , righi
408.             lef = lefi / 65535
409.             righ = righi / 65535
410.         END IF
411.  
412.         IF RATE > 44100 THEN frekvence = RATE ELSE frekvence = 44100
413.  
414.         oss = UBOUND(OutputSound)
415.         REDIM _PRESERVE OutputSound(oss + (frekvence / RATE)) AS Snd
416.  
417.         FOR plll = 1 TO frekvence / RATE
418.             OutputSound(oss + plll).Left = lef
419.             OutputSound(oss + plll).Right = righ
420.         NEXT plll
421.  
422.         DO WHILE _SNDRAWLEN > 0: LOOP: REM comment this
423.     LOOP
424.  
425.     OTP(OTP_Size).Offset_End = UBOUND(outputsound)
426.     REDIM _PRESERVE OTP(OTP_Size + 1) AS OtpSndHelper
427.     CLOSE ch
428.     WAVtoRAW = OTP_Size
429. END FUNCTION
430.  
431. FUNCTION Find_data_area (handle$)
432.     REDIM D AS STRING * 1024
433.     ff = FREEFILE
434.     OPEN handle$ FOR BINARY AS #ff
435.     GET #ff, 1, D$
436.     CLOSE #ff
437.     Find_data_area = INSTR(1, D$, "data") + 8
438. END FUNCTION
439.  
440. SUB SAVESOUND16S (arr() AS Snd, file AS STRING)
441.  
442.     TYPE head16
443.         chunk AS STRING * 4 '       4 bytes  (RIFF)
444.         size AS LONG '              4 bytes  (file size)
445.         fomat AS STRING * 4 '       4 bytes  (WAVE)
446.         sub1 AS STRING * 4 '        4 bytes  (fmt )
447.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
448.         format AS INTEGER '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
449.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
450.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
451.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
452.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
453.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
454.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
455.         lenght AS LONG '            4 bytes  Data block size
456.     END TYPE '                     44 bytes  total
457.     DIM H16 AS head16
458.     ch = FREEFILE
459.  
460.     H16.chunk = "RIFF"
461.     H16.size = 44 + UBOUND(arr) * 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
462.  
463.     H16.fomat = "WAVE"
464.     H16.sub1 = "fmt "
465.     H16.subchunksize = 16
466.     H16.format = 1
467.     H16.channels = 2
468.     H16.rate = 44100
469.     H16.ByteRate = 44100 * 2 * 16 / 8
470.     H16.Block = 4
471.     H16.Bits = 16
472.     H16.subchunk2 = "data"
473.     H16.lenght = UBOUND(arr) * 4
474.     IF _FILEEXISTS(file$) THEN KILL file$
475.  
476.     OPEN file$ FOR BINARY AS #ch
477.     PUT #ch, , H16
478.     DIM LeftChannel AS INTEGER, RightChannel AS INTEGER
479.  
480.     FOR audiodata = 0 TO UBOUND(arr)
481.         LeftChannel = arr(audiodata).Left * 32768
482.         RightChannel = arr(audiodata).Right * 32768
483.  
484.         PUT #ch, , LeftChannel
485.         PUT #ch, , RightChannel
486.     NEXT
487.     CLOSE ch
488. END SUB
489.  

[Petr]

_vince, thank you for a beautiful example! I haven't had much time in the last two days, I'll look to it depthly as soon as possible.

[_vince]

No pressure, Petr, take your time, da si zabraven, razberi! These are good exercises for me being a good application of my code and potentially good info for others.  The perfect demo for this would be something like an audio equalizer, I might go for it, unfortunately SNDPLAY doesnt work on my install but your WAV reading/writing code is good enough.

[Dav]

I'm still trying to wrap my brain around this stuff, but it's pretty neat! 
 
- Dav

[STxAxTIC]

Ah, the good old fast fourier transform. How could I not chime in?

Yes vince - make an equalizer - you're in the right place at the right time!

[Petr]

My dream of sound equalization (especially bass boosting) is coming true. I didn't use the Fourrier transform, but the trick I came across by chance. I am attaching a wav, created in QB64. Low biterate is intentional in this case and it is exactly the part of the sound that the bass part of the amplifier will amplify. The other frequencies are obtained by the difference of the samples obtained in this way.


Important note: There is a serious risk of damage to the speakers this time! I love QB64!

Message for _Vince: YA ne znayu, chto vy imeyete v vidu.