Random Melodies and Chords (first complete and second rewrite - Bug Question)

[Petr]

Not. I always have a different sound if uncomment the previous two _SNDRAW commands. Please make sure that when using _SNDRAW you have turned off all sound effects such as dolby and surround sound, it has a direct effect on the _SNDRAW output.

[Petr]

You can try also some combinations als:

        _SNDRAW sample1, , S3
        '_SNDRAWDONE
        _SNDRAW sample2, , S3
        '_SNDRAWDONE
        _SNDRAW sample3, , S1

[chlorophyll-zz]

Not. I always have a different sound if uncomment the previous two _SNDRAW commands. Please make sure that when using _SNDRAW you have turned off all sound effects such as dolby and surround sound, it has a direct effect on the _SNDRAW output.

First, I want to thank you for you for your compliment a few post before, I forgot that entirely.

Second, it turns out; You was right with _SNDRAWOPEN and I was wrong in my last post.
Please excuse me, I was in a hurry and had not the time to listen carefully.
Also, the 440+220+110 Hz example, was a bad example (from me).

I wrote the example Code now for C-Major (C-E-G),
and compared to this recording:

It turns out that the code from you produces indeed the right Chord.

Now I am editing my Melodies code to fit your good (and completely accurate) example.
Thank You for teaching me!

For completeness, this example code produces a C Major Chord in Octave 4 (C4-E4-G4)

Code: QB64: [Select]

1. t = 0
2. tmp$ = "Sample = ##.#####   Time = ##.#####"
3. Locate 1, 60: Print "Rate:"; _SndRate
4.  
5. S1 = _SndOpenRaw
6. S2 = _SndOpenRaw
7. S3 = _SndOpenRaw
8.  
9. Do
10.     'queue some sound
11.     Do Until t >= 3 'you may wish to adjust this
12.         sample1 = Sin(t * 261.626 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2?)
13.         sample1 = sample1 * Exp(-t * 3) / 3 'fade out eliminates clicks after sound
14.        
15.         sample2 = Sin(t * 329.628 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2?)
16.         sample2 = sample2 * Exp(-t * 3) / 3 'fade out eliminates clicks after sound
17.  
18.         sample3 = Sin(t * 391.995 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2?)
19.         sample3 = sample3 * Exp(-t * 3) / 3 'fade out eliminates clicks after sound
20.  
21.         t = t + 1 / _SndRate
22.         _SndRaw sample1, , S1
23.         _SndRawDone
24.         _SndRaw sample2, , S2
25.         _SndRawDone
26.         _SndRaw sample3, , S3
27.         _SndRawDone
28.  
29.         Locate 1, 1: Print Using tmp$; sample; t
30.  
31.  
32.     Loop
33.  
34.     _SndClose S1
35.     _SndClose S2
36.     _SndClose S3
37.  
38.     'do other stuff, but it may interrupt sound
39.     Locate 1, 1: Print Using tmp$; sample; t
40. Loop While t < 3.0 'play for 3 seconds
41.  
42. Do While _SndRawLen > 0 'Finish any left over queued sound!
43. Loop
44. End
45.  
46.  
47.  

[chlorophyll-zz]

I could not get the program to work with your  _SNDRAWOPEN method, it always failed on the first _SNDRAW
I reverted completely to your first method of adding the samples and dividing by 2.
This is the newest code. The Chords work and everything else too, so far.
Sometimes I have clicks, but I can live with that.

Code: QB64: [Select]

1. Dim fm(88) As Double
2. Dim f As Double
3. Dim tn(88) As String
4. Dim in As String
5. Randomize Timer(.001)
6. Dim t As Double
7.  
8. Print "Welcone to Random Tones and Chords Generator v0.1b"
9. Print
10. Input "Please specify Chord possibility in % (25)"; uaw$
11. If uaw$ = "" Or Val(uaw$) < 0 Or Val(uaw$) > 100 Then
12.     aw = 25
13. Else aw = Val(uaw$)
14. End If
15. Print "Chords possibility:"; aw; "%"
16. bpm = 120
17. 'interval 1 and 2 (semitones)
18. int1 = 4
19. int2 = 7
20. 'interval possibility percent
21. 'aw = 25
22. 'tone minimum and maximum
23. tmin = 35
24. tmax = 47
25. 'lengths min and max
26. lmin = 2
27. lmax = 4
28. 'fill the tone names
29. For i = 1 To 88
30.     f = ((2 ^ ((i - 49) / 12)) * 440)
31.     fm(i) = CInt(f)
32.     Select Case i Mod 12
33.         Case 1: tn(i) = "A"
34.         Case 2: tn(i) = "A#"
35.         Case 3: tn(i) = "B"
36.         Case 4: tn(i) = "C"
37.         Case 5: tn(i) = "C#"
38.         Case 6: tn(i) = "D"
39.         Case 7: tn(i) = "D#"
40.         Case 8: tn(i) = "E"
41.         Case 9: tn(i) = "F"
42.         Case 10: tn(i) = "F#"
43.         Case 11: tn(i) = "G"
44.         Case 0: tn(i) = "G#"
45.     End Select
46.     'Select Case Int(i / 12)
47.     '    Case 0: tn(i) = tn(i) + "0"
48.  
49.     'End Select
50.     'DEBUG
51.     'Print f; tn(i)
52.     'If i > 24 Then Sleep
53. Next i
54.  
55. 'delete all sharp tones
56. For i = 1 To 88
57.     If Mid$(tn(i), 2, 1) = "#" Then
58.         tn(i) = tn(i - 1)
59.         fm(i) = fm(i - 1)
60.     End If
61. Next i
62. 'DEBUG fm(49)="A"
63. 'Print fm(49)
64.  
65. 'fill the lengths
66. For i = 1 To 7
67.     lm(i) = 2 ^ i / 2
68.     'DEBUG
69.     'Print lm(i)
70.  
71. Next i
72.  
73. Do
74.     'tones between tmin and tmax
75.     i = CInt((Rnd * (tmax - tmin)) + tmin)
76.  
77.     lr = lm(CInt(Rnd * (lmax - lmin)) + lmin) 'Length out of the lenght fields between 2 and 4
78.     l = 1 / lr * 60 / bpm * 4 'Lenght is parts of a second from the length fields multiplied by bpm
79.  
80.     If Rnd < aw / 100 Then
81.         akk = 1
82.     Else akk = 0
83.     End If
84.  
85.     t = 0
86.     If akk = 1 Then
87.         Print "Length 1/"; LTrim$(Str$(lr)); " Tone:"; tn(i); "+"; tn(i + int1); "+"; tn(i + 7)
88.     Else Print "Length 1/"; LTrim$(Str$(lr)); " Tone:"; tn(i)
89.     End If
90.     Do
91.         'queue some sound
92.         Do While t < l 'you may wish to adjust this
93.             sample1 = Sin(t * fm(i) * Atn(1) * 8) / 3 * 2
94.             sample1 = sample1 * Exp(-t * l) / 3 * 2
95.  
96.             t = t + 1 / _SndRate
97.  
98.             If akk = 1 Then
99.                 sample2 = Sin(t * fm(i + int1) * Atn(1) * 8) / 3 * 2
100.                 sample2 = sample2 * Exp(-t * l) / 3 * 2
101.                 sample1 = (sample1 + sample2) / 2
102.                 '_SndRaw sample2
103.                 't = t + 1 / _SndRate
104.                 sample3 = Sin(t * fm(i + int2) * Atn(1) * 8) / 3 * 2
105.                 sample3 = sample3 * Exp(-t * l) / 3 * 2
106.                 sample1 = (sample1 + sample3) / 2
107.                 '_SndRaw sample
108.                 't = t + 1 / _SndRate
109.             End If
110.             _SndRaw sample1
111.  
112.         Loop
113.  
114.  
115.     Loop While t < l 'play for l seconds
116.  
117.     Do While _SndRawLen > 0 'Finish any left over queued sound!
118.     Loop
119.     _SndRawDone
120.  
121.     in = InKey$
122. Loop While in = ""
123.  
124.  
125.  

[bplus]

Ah, you've cleaned the crumbs from my speaker sounds better. :)

[Petr]

@chlorophyll-zz  Thank for reply. I played around with your program a bit, so now you can generate sound files, for example, as effects for games, or just like that. The attached source code creates a generated.wav file

Code: QB64: [Select]

1.  
2. DIM fm(88) AS DOUBLE
3. DIM f AS DOUBLE
4. DIM tn(88) AS STRING
5. DIM in AS STRING
6. RANDOMIZE TIMER(.001)
7. DIM t AS DOUBLE
8. DIM Left AS _MEM, Right AS _MEM
9.  
10.  
11.  
12.  
13. PRINT "Welcone to Random Tones and Chords Generator v0.1b"
14. PRINT
15. INPUT "Please specify Chord possibility in % (25)"; uaw$
16. INPUT "Please set music time [sec] for generating WAV file:"; WAVLen
17.  
18. DIM RawMusic(_CEIL(_SNDRATE * WAVLen)) AS SINGLE
19.  
20. Left = _MEM(RawMusic())
21. Right = _MEM(RawMusic()) 'mono signal, so both channels are the same
22.  
23. IF uaw$ = "" OR VAL(uaw$) < 0 OR VAL(uaw$) > 100 THEN
24.     aw = 25
25. ELSE aw = VAL(uaw$)
26. END IF
27. PRINT "Chords possibility:"; aw; "%"
28. bpm = 120
29. 'interval 1 and 2 (semitones)
30. int1 = 4
31. int2 = 7
32. 'interval possibility percent
33. 'aw = 25
34. 'tone minimum and maximum
35. tmin = 35
36. tmax = 47
37. 'lengths min and max
38. lmin = 2
39. lmax = 4
40. 'fill the tone names
41. FOR i = 1 TO 88
42.     f = ((2 ^ ((i - 49) / 12)) * 440)
43.     fm(i) = CINT(f)
44.     SELECT CASE i MOD 12
45.         CASE 1: tn(i) = "A"
46.         CASE 2: tn(i) = "A#"
47.         CASE 3: tn(i) = "B"
48.         CASE 4: tn(i) = "C"
49.         CASE 5: tn(i) = "C#"
50.         CASE 6: tn(i) = "D"
51.         CASE 7: tn(i) = "D#"
52.         CASE 8: tn(i) = "E"
53.         CASE 9: tn(i) = "F"
54.         CASE 10: tn(i) = "F#"
55.         CASE 11: tn(i) = "G"
56.         CASE 0: tn(i) = "G#"
57.     END SELECT
58.     'Select Case Int(i / 12)
59.     '    Case 0: tn(i) = tn(i) + "0"
60.  
61.     'End Select
62.     'DEBUG
63.     'Print f; tn(i)
64.     'If i > 24 Then Sleep
65. NEXT i
66.  
67. 'delete all sharp tones
68. FOR i = 1 TO 88
69.     IF MID$(tn(i), 2, 1) = "#" THEN
70.         tn(i) = tn(i - 1)
71.         fm(i) = fm(i - 1)
72.     END IF
73. NEXT i
74. 'DEBUG fm(49)="A"
75. 'Print fm(49)
76.  
77. 'fill the lengths
78. FOR i = 1 TO 7
79.     lm(i) = 2 ^ i / 2
80.     'DEBUG
81.     'Print lm(i)
82.  
83. NEXT i
84.  
85. DO
86.     'tones between tmin and tmax
87.     i = CINT((RND * (tmax - tmin)) + tmin)
88.  
89.     lr = lm(CINT(RND * (lmax - lmin)) + lmin) 'Length out of the lenght fields between 2 and 4
90.     L = 1 / lr * 60 / bpm * 4 'Lenght is parts of a second from the length fields multiplied by bpm
91.  
92.     IF RND < aw / 100 THEN
93.         akk = 1
94.     ELSE akk = 0
95.     END IF
96.  
97.     t = 0
98.     IF akk = 1 THEN
99.         PRINT "Length 1/"; LTRIM$(STR$(lr)); " Tone:"; tn(i); "+"; tn(i + int1); "+"; tn(i + 7)
100.     ELSE PRINT "Length 1/"; LTRIM$(STR$(lr)); " Tone:"; tn(i)
101.     END IF
102.     DO
103.         'queue some sound
104.         DO WHILE t < L 'you may wish to adjust this
105.             sample1 = SIN(t * fm(i) * ATN(1) * 8) / 3 * 2
106.             sample1 = sample1 * EXP(-t * L) / 3 * 2
107.  
108.             t = t + 1 / _SNDRATE
109.  
110.             IF akk = 1 THEN
111.                 sample2 = SIN(t * fm(i + int1) * ATN(1) * 8) / 3 * 2
112.                 sample2 = sample2 * EXP(-t * L) / 3 * 2
113.                 sample1 = (sample1 + sample2) / 2
114.                 '_SndRaw sample2
115.                 't = t + 1 / _SndRate
116.                 sample3 = SIN(t * fm(i + int2) * ATN(1) * 8) / 3 * 2
117.                 sample3 = sample3 * EXP(-t * L) / 3 * 2
118.                 sample1 = (sample1 + sample3) / 2
119.                 '_SndRaw sample
120.                 't = t + 1 / _SndRate
121.             END IF
122.  
123.             _SNDRAW sample1
124.             RawMusic(rwi) = sample1
125.             rwi = rwi + 1
126.  
127.             IF rwi > UBOUND(rawmusic) THEN
128.                 PRINT "Sound generated, saving to file generated.wav"
129.                 _DELAY .5
130.                 SAVESOUND8S Left, Right, "generated.wav"
131.                 _MEMFREE Left
132.                 _MEMFREE Right
133.                 ERASE RawMusic
134.                 SYSTEM
135.             END IF
136.         LOOP
137.  
138.  
139.     LOOP WHILE t < L 'play for l seconds
140.  
141.     DO WHILE _SNDRAWLEN > 0 'Finish any left over queued sound!
142.     LOOP
143.     _SNDRAWDONE
144.  
145.  
146. LOOP WHILE in = ""
147.  
148.  
149.  
150.  
151.  
152.  
153.  
154.  
155.  
156.  
157. SUB SAVESOUND8S (Left AS _MEM, Right AS _MEM, file AS STRING) 'Left and Right memory blocks contains value -1 to 1 (_SNDRAW compatible)
158.  
159.     Size = OFFSET_to_I64(Left.SIZE) 'convertion is used for WAV file header, becuse offset value can not be used directly
160.  
161.     TYPE head8
162.         chunk AS STRING * 4 '       4 bytes  (RIFF)
163.         size AS LONG '              4 bytes  (file size)
164.         fomat AS STRING * 4 '       4 bytes  (WAVE)
165.         sub1 AS STRING * 4 '        4 bytes  (fmt )
166.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
167.         format AS INTEGER '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
168.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
169.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
170.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
171.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
172.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
173.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
174.         lenght AS LONG '            4 bytes  Data block size
175.     END TYPE '                     44 bytes  total
176.     DIM H8 AS head8
177.     ch = FREEFILE
178.  
179.     H8.chunk = "RIFF"
180.     H8.size = 44 + Size / 2
181.  
182.     H8.fomat = "WAVE"
183.     H8.sub1 = "fmt "
184.     H8.subchunksize = 16
185.     H8.format = 1
186.     H8.channels = 2
187.     H8.rate = 44100
188.     H8.ByteRate = 44100 * 2 * 8 / 8
189.     H8.Block = 2
190.     H8.Bits = 8
191.     H8.subchunk2 = "data"
192.     H8.lenght = Size / 2
193.     IF _FILEEXISTS(file$) THEN KILL file$
194.  
195.     OPEN file$ FOR BINARY AS #ch
196.     PUT #ch, , H8
197.  
198.     DIM LeftChannel8 AS _BYTE, RightChannel8 AS _BYTE, RawLeft AS SINGLE, RawRight AS SINGLE
199.     DIM Recalc AS _MEM, size AS _OFFSET
200.  
201.     size = Left.SIZE 'now this value is for memory size used by SINGLE ARRAY - WAV 8bit need 1 byte for 1 channel and 1 sample
202.  
203.     'recalculate audiodata to file - byte - values
204.  
205.     Recalc = _MEMNEW(size / 2) 'this is value used by WAV - size is 4 byte per sample, we recording stereo (2 x 1 byte) therefore is this divided by 2
206.  
207.     start& = 0: LRO& = 0
208.     DO UNTIL start& = Left.SIZE
209.         RawLeft = _MEMGET(Left, Left.OFFSET + start&, SINGLE)
210.         RawRight = _MEMGET(Right, Right.OFFSET + start&, SINGLE)
211.  
212.         LeftChannel8 = 128 - RawLeft * 128
213.         RightChannel8 = 128 - RawRight * 128
214.  
215.         _MEMPUT Recalc, Recalc.OFFSET + s&, LeftChannel8
216.         _MEMPUT Recalc, Recalc.OFFSET + s& + 1, RightChannel8
217.         s& = s& + 2
218.         start& = start& + 4
219.     LOOP
220.  
221.     'write audio data to file
222.  
223.     WAVeRAW$ = SPACE$(s&)
224.     _MEMGET Recalc, Recalc.OFFSET, WAVeRAW$
225.     PUT #ch, , WAVeRAW$
226.  
227.     'erase memory
228.     _MEMFREE Recalc
229.     WAVeRAW$ = ""
230.     CLOSE ch
231. END SUB
232.  
233. FUNCTION OFFSET_to_I64 (value AS _OFFSET)
234.     DIM m AS _MEM
235.     $IF 32BIT THEN
236.         dim num as long
237.         m = _mem(num)
238.         _memput m,m.offset, value
239.         Offset_to_i64 = num
240.         _memfree m
241.     $ELSE
242.         DIM num AS _INTEGER64
243.         m = _MEM(num)
244.         _MEMPUT m, m.OFFSET, value
245.         OFFSET_to_I64 = num
246.         _MEMFREE m
247.     $END IF
248. END FUNCTION
249.  

[chlorophyll-zz]

@you can generate sound files

Wow, how cool is that! I could never accomplish writing a WAV file.

I also thought about adding a load and save function,
and saving or loading the tone names and Octaves and Chords in a Text-File.

Or for example (this is (for me )a huge project,) adding a "like-key",
so the Program would play the same chord transitions that you liked more often.

But now the chords are note gone.
Thank you!

[Petr]

I'm glad you like it. You could still have a lot of fun with it. That LIKE button, it would mean that you write in the field where the individual tones starts and ends (from which sample to which sample).

[chlorophyll-zz]

That LIKE button, it would mean that you write in the field where the individual tones starts and ends (from which sample to which sample).

I would save the sequence of the last x transitions, so for one example if I have a transition from C4 to E4, I would write a transition of 2 full tones in the like field.
Or for a melody, I would write the transitions from the last x tones and prefer these transitions more.
For that, I would have to calculate a whole block with lengths and tones before the tone generation starts.
So I could pick up the sequence that the user liked, again.

[Petr]

Here's how: Let's say the user likes a combination of tones that played from 3 seconds to 4 seconds. All samples that have already been played are stored in the global field of all sound samples. Therefore, there is no need to regenerate tones and their combination, just copy it. The start of copying is in time 3 seconds, that is, from sample 44100 * 3, the end is in time 4 seconds, that is to sample 44100 * 4. That global field of all samples is RawMusic field, see line 124 of the program source code, which output saves as WAV.

[chlorophyll-zz]

I added an input check and default (120s) for WaveLen and added a BPM input with check and default (120bpm).
Do you think 120 Seconds is to short for WaveLen?

Code: QB64: [Select]

1. Dim fm(88) As Double
2. Dim f As Double
3. Dim tn(88) As String
4. Dim in As String
5. Randomize Timer(.001)
6. Dim t As Double
7. Dim Left As _MEM, Right As _MEM
8.  
9.  
10.  
11.  
12. Print "Welcone to Random Tones and Chords Generator v0.1b"
13. Print
14. Input "Please specify Chord possibility in % (25)"; uaw$
15. Input "Please set BPM (120)"; ubpm$
16. Input "Please set music time [sec] for generating WAV file:(120)"; uWAVLen$
17.  
18. Dim RawMusic(_Ceil(_SndRate * WAVLen)) As Single
19.  
20. Left = _Mem(RawMusic())
21. Right = _Mem(RawMusic()) 'mono signal, so both channels are the same
22.  
23. If uaw$ = "" Or Val(uaw$) < 0 Or Val(uaw$) > 100 Then
24.     aw = 25
25. Else aw = Val(uaw$)
26. End If
27. Print "Chords possibility:"; aw; "%"
28.  
29.  
30. If uWAVLen$ = "" Or Val(uWAVLen$) < 0 Or Val(uWAVLen$) > 1000 Then
31.     WAVLen = 120
32. Else WAVLen = Val(uWAVLen$)
33. End If
34. Print "Music Time:"; LTrim$(Str$(WAVLen)); "s"
35.  
36. If ubpm$ = "" Or Val(ubpm$) < 0 Or Val(ubpm$) > 1000 Then
37.     bpm = 120
38. Else bpm = Val(ubpm$)
39. End If
40. Print "BPM:"; bpm
41.  
42.  
43. 'bpm = 120
44. 'interval 1 and 2 (semitones)
45. int1 = 4
46. int2 = 7
47. 'interval possibility percent
48. 'aw = 25
49. 'tone minimum and maximum
50. tmin = 35
51. tmax = 47
52. 'lengths min and max
53. lmin = 2
54. lmax = 4
55. 'fill the tone names
56. For i = 1 To 88
57.     f = ((2 ^ ((i - 49) / 12)) * 440)
58.     fm(i) = CInt(f)
59.     Select Case i Mod 12
60.         Case 1: tn(i) = "A"
61.         Case 2: tn(i) = "A#"
62.         Case 3: tn(i) = "B"
63.         Case 4: tn(i) = "C"
64.         Case 5: tn(i) = "C#"
65.         Case 6: tn(i) = "D"
66.         Case 7: tn(i) = "D#"
67.         Case 8: tn(i) = "E"
68.         Case 9: tn(i) = "F"
69.         Case 10: tn(i) = "F#"
70.         Case 11: tn(i) = "G"
71.         Case 0: tn(i) = "G#"
72.     End Select
73.     'Select Case Int(i / 12)
74.     '    Case 0: tn(i) = tn(i) + "0"
75.  
76.     'End Select
77.     'DEBUG
78.     'Print f; tn(i)
79.     'If i > 24 Then Sleep
80. Next i
81.  
82. 'delete all sharp tones
83. For i = 1 To 88
84.     If Mid$(tn(i), 2, 1) = "#" Then
85.         tn(i) = tn(i - 1)
86.         fm(i) = fm(i - 1)
87.     End If
88. Next i
89. 'DEBUG fm(49)="A"
90. 'Print fm(49)
91.  
92. 'fill the lengths
93. For i = 1 To 7
94.     lm(i) = 2 ^ i / 2
95.     'DEBUG
96.     'Print lm(i)
97.  
98. Next i
99.  
100. Do
101.     'tones between tmin and tmax
102.     i = CInt((Rnd * (tmax - tmin)) + tmin)
103.  
104.     lr = lm(CInt(Rnd * (lmax - lmin)) + lmin) 'Length out of the lenght fields between 2 and 4
105.     L = 1 / lr * 60 / bpm * 4 'Lenght is parts of a second from the length fields multiplied by bpm
106.  
107.     If Rnd < aw / 100 Then
108.         akk = 1
109.     Else akk = 0
110.     End If
111.  
112.     t = 0
113.     If akk = 1 Then
114.         Print "Length 1/"; LTrim$(Str$(lr)); " Tone:"; tn(i); "+"; tn(i + int1); "+"; tn(i + 7)
115.     Else Print "Length 1/"; LTrim$(Str$(lr)); " Tone:"; tn(i)
116.     End If
117.     Do
118.         'queue some sound
119.         Do While t < L 'you may wish to adjust this
120.             sample1 = Sin(t * fm(i) * Atn(1) * 8) / 3 * 2
121.             sample1 = sample1 * Exp(-t * L) / 3 * 2
122.  
123.             t = t + 1 / _SndRate
124.  
125.             If akk = 1 Then
126.                 sample2 = Sin(t * fm(i + int1) * Atn(1) * 8) / 3 * 2
127.                 sample2 = sample2 * Exp(-t * L) / 3 * 2
128.                 sample1 = (sample1 + sample2) / 2
129.                 '_SndRaw sample2
130.                 't = t + 1 / _SndRate
131.                 sample3 = Sin(t * fm(i + int2) * Atn(1) * 8) / 3 * 2
132.                 sample3 = sample3 * Exp(-t * L) / 3 * 2
133.                 sample1 = (sample1 + sample3) / 2
134.                 '_SndRaw sample
135.                 't = t + 1 / _SndRate
136.             End If
137.  
138.             _SndRaw sample1
139.             RawMusic(rwi) = sample1
140.             rwi = rwi + 1
141.  
142.             If rwi > UBound(RawMusic) Then
143.                 Print "Sound generated, saving to file generated.wav"
144.                 _Delay .5
145.                 SAVESOUND8S Left, Right, "generated.wav"
146.                 _MemFree Left
147.                 _MemFree Right
148.                 Erase RawMusic
149.                 System
150.             End If
151.         Loop
152.  
153.  
154.     Loop While t < L 'play for l seconds
155.  
156.     Do While _SndRawLen > 0 'Finish any left over queued sound!
157.     Loop
158.     _SndRawDone
159.  
160.  
161. Loop While in = ""
162.  
163.  
164.  
165.  
166.  
167.  
168.  
169.  
170.  
171.  
172. Sub SAVESOUND8S (Left As _MEM, Right As _MEM, file As String) 'Left and Right memory blocks contains value -1 to 1 (_SNDRAW compatible)
173.  
174.     Size = OFFSET_to_I64(Left.SIZE) 'convertion is used for WAV file header, becuse offset value can not be used directly
175.  
176.     Type head8
177.         chunk As String * 4 '       4 bytes  (RIFF)
178.         size As Long '              4 bytes  (file size)
179.         fomat As String * 4 '       4 bytes  (WAVE)
180.         sub1 As String * 4 '        4 bytes  (fmt )
181.         subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
182.         format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
183.         channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
184.         rate As Long '              4 bytes  (sample rate, standard is 44100)
185.         ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
186.         Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
187.         Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
188.         subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
189.         lenght As Long '            4 bytes  Data block size
190.     End Type '                     44 bytes  total
191.     Dim H8 As head8
192.     ch = FreeFile
193.  
194.     H8.chunk = "RIFF"
195.     H8.size = 44 + Size / 2
196.  
197.     H8.fomat = "WAVE"
198.     H8.sub1 = "fmt "
199.     H8.subchunksize = 16
200.     H8.format = 1
201.     H8.channels = 2
202.     H8.rate = 44100
203.     H8.ByteRate = 44100 * 2 * 8 / 8
204.     H8.Block = 2
205.     H8.Bits = 8
206.     H8.subchunk2 = "data"
207.     H8.lenght = Size / 2
208.     If _FileExists(file$) Then Kill file$
209.  
210.     Open file$ For Binary As #ch
211.     Put #ch, , H8
212.  
213.     Dim LeftChannel8 As _Byte, RightChannel8 As _Byte, RawLeft As Single, RawRight As Single
214.     Dim Recalc As _MEM, size As _Offset
215.  
216.     size = Left.SIZE 'now this value is for memory size used by SINGLE ARRAY - WAV 8bit need 1 byte for 1 channel and 1 sample
217.  
218.     'recalculate audiodata to file - byte - values
219.  
220.     Recalc = _MemNew(size / 2) 'this is value used by WAV - size is 4 byte per sample, we recording stereo (2 x 1 byte) therefore is this divided by 2
221.  
222.     start& = 0: LRO& = 0
223.     Do Until start& = Left.SIZE
224.         RawLeft = _MemGet(Left, Left.OFFSET + start&, Single)
225.         RawRight = _MemGet(Right, Right.OFFSET + start&, Single)
226.  
227.         LeftChannel8 = 128 - RawLeft * 128
228.         RightChannel8 = 128 - RawRight * 128
229.  
230.         _MemPut Recalc, Recalc.OFFSET + s&, LeftChannel8
231.         _MemPut Recalc, Recalc.OFFSET + s& + 1, RightChannel8
232.         s& = s& + 2
233.         start& = start& + 4
234.     Loop
235.  
236.     'write audio data to file
237.  
238.     WAVeRAW$ = Space$(s&)
239.     _MemGet Recalc, Recalc.OFFSET, WAVeRAW$
240.     Put #ch, , WAVeRAW$
241.  
242.     'erase memory
243.     _MemFree Recalc
244.     WAVeRAW$ = ""
245.     Close ch
246. End Sub
247.  
248. Function OFFSET_to_I64 (value As _Offset)
249.     Dim m As _MEM
250.     $If 32BIT Then
251.         DIM num AS LONG
252.         m = _MEM(num)
253.         _MEMPUT m,m.offset, value
254.         Offset_to_i64 = num
255.         _MEMFREE m
256.     $Else
257.         Dim num As _Integer64
258.         m = _Mem(num)
259.         _MemPut m, m.OFFSET, value
260.         OFFSET_to_I64 = num
261.         _MemFree m
262.     $End If
263. End Function
264.  
265.  

[Petr]

Hi.

Repair row 18 in your last source code as:

DIM RawMusic(_CEIL(_SNDRATE * VAL(uWAVLen$))) AS SINGLE

for music record funcionality.

So - but this is just a suggestion - just graphically display the individual samples, or enter the start and end of the sequence via INPUT, which the user wants to repeat, and this can then be copied anywhere in the original samples and thus create a new sequence. You can even cut it this way and then save it individually, but in that case you have to back up the RawMusic field to another SINGLE type field, because RawMusic is taken as the source for saving. You can modify it as you wish and save it, you just have to get the intended output into the RawMusic field.

Another option (this is already offered by working with the fields itself) is the possibility of adding a shift of the left channel compared to the right one or reversing the direction of playback, it already depends on the imagination.

[chlorophyll-zz]

Repair row 18 in your last source code as:

DIM RawMusic(_CEIL(_SNDRATE * VAL(uWAVLen$))) AS SINGLE

No. uWAVLen is just the user input. Therefore the u Character in front. I capture it as a String to validate against "" (just pressing enter for default).
After the check for "" and below 0 and above 1000, the uWAVLen gets converted to WAVLen=VAL(uWAVLen). (Line 32)
It works like you intended. ;-)

[chlorophyll-zz]

Hi.

Repair row 18 in your last source code as:

DIM RawMusic(_CEIL(_SNDRATE * VAL(uWAVLen$))) AS SINGLE

Ah, now I see, when I press enter, the uWAVLen gets a DIM(0).
Now I put the DIM after the check.
Also, I implemented Pauses (5%)?

Code: QB64: [Select]

1. Dim fm(88) As Double
2. Dim f As Double
3. Dim tn(88) As String
4. Dim in As String
5. Randomize Timer(.001)
6. Dim t As Double
7. Dim Left As _MEM, Right As _MEM
8.  
9.  
10.  
11.  
12. Print "Welcone to Random Tones and Chords Generator v0.1b"
13. Print
14. Input "Please specify Chord possibility in % (25):"; uaw$
15. Input "Please set music time [sec] for generating WAV file (120):"; uWAVLen
16. Input "Please set BPM (120):"; ubpm$
17. Input "Please set Pauses possibility in % (5):"; up$
18.  
19. If uWAVLen$ = "" Or Val(uWAVLen$) < 0 Or Val(uWAVLen$) > 1000 Then
20.     WAVLen = 120
21. Else WAVLen = Val(uWAVLen$)
22. End If
23. Print "Music Time:"; LTrim$(Str$(WAVLen)); "s"
24.  
25. If uaw$ = "" Or Val(uaw$) < 0 Or Val(uaw$) > 100 Then
26.     aw = 25
27. Else aw = Val(uaw$)
28. End If
29. Print "Chords possibility:"; aw; "%"
30.  
31. If ubpm$ = "" Or Val(ubpm$) < 0 Or Val(ubpm$) > 1000 Then
32.     bpm = 120
33. Else bpm = Val(ubpm$)
34. End If
35. Print "BPM:"; bpm
36.  
37.  
38. If up$ = "" Or Val(up$) < 0 Or Val(up$) > 100 Then
39.     pperc = 5
40. Else pperc = Val(up$)
41. End If
42. Print "Pauses:"; LTrim$(Str$(pperc)); "%"
43.  
44.  
45. Dim RawMusic(_Ceil(_SndRate * WAVLen)) As Single
46.  
47. Left = _Mem(RawMusic())
48. Right = _Mem(RawMusic()) 'mono signal, so both channels are the same
49.  
50.  
51. 'bpm = 120
52. 'interval 1 and 2 (semitones)
53. int1 = 4
54. int2 = 7
55. 'interval possibility percent
56. 'aw = 25
57. 'tone minimum and maximum
58. tmin = 35
59. tmax = 47
60. 'lengths min and max
61. lmin = 2
62. lmax = 4
63. 'fill the tone names
64. For i = 1 To 88
65.     f = ((2 ^ ((i - 49) / 12)) * 440)
66.     fm(i) = CInt(f)
67.     Select Case i Mod 12
68.         Case 1: tn(i) = "A"
69.         Case 2: tn(i) = "A#"
70.         Case 3: tn(i) = "B"
71.         Case 4: tn(i) = "C"
72.         Case 5: tn(i) = "C#"
73.         Case 6: tn(i) = "D"
74.         Case 7: tn(i) = "D#"
75.         Case 8: tn(i) = "E"
76.         Case 9: tn(i) = "F"
77.         Case 10: tn(i) = "F#"
78.         Case 11: tn(i) = "G"
79.         Case 0: tn(i) = "G#"
80.     End Select
81.     'Select Case Int(i / 12)
82.     '    Case 0: tn(i) = tn(i) + "0"
83.  
84.     'End Select
85.     'DEBUG
86.     'Print f; tn(i)
87.     'If i > 24 Then Sleep
88. Next i
89.  
90. 'delete all sharp tones
91. For i = 1 To 88
92.     If Mid$(tn(i), 2, 1) = "#" Then
93.         tn(i) = tn(i - 1)
94.         fm(i) = fm(i - 1)
95.     End If
96. Next i
97. 'DEBUG fm(49)="A"
98. 'Print fm(49)
99.  
100. 'fill the lengths
101. For i = 1 To 7
102.     lm(i) = 2 ^ i / 2
103.     'DEBUG
104.     'Print lm(i)
105.  
106. Next i
107.  
108. Do
109.     'tones between tmin and tmax
110.     i = CInt((Rnd * (tmax - tmin)) + tmin)
111.  
112.     'Pauses
113.     If Rnd < pperc / 100 Then p = 1 Else p = 0
114.  
115.     lr = lm(CInt(Rnd * (lmax - lmin)) + lmin) 'Length out of the lenght fields between 2 and 4
116.     L = 1 / lr * 60 / bpm * 4 'Lenght is parts of a second from the length fields multiplied by bpm
117.  
118.     If Rnd < aw / 100 Then
119.         akk = 1
120.     Else akk = 0
121.     End If
122.  
123.     t = 0
124.     If akk = 1 And p = 0 Then
125.         Print "1/"; LTrim$(Str$(lr)); " Tone:"; tn(i); "+"; tn(i + int1); "+"; tn(i + 7)
126.     ElseIf akk = 0 And p = 0 Then Print "1/"; LTrim$(Str$(lr)); " Tone:"; tn(i)
127.     ElseIf p = 1 Then Print "1/"; LTrim$(Str$(lr)); " Pause"
128.     End If
129.     Do
130.         'queue some sound
131.         Do While t < L 'you may wish to adjust this
132.             sample1 = Sin(t * fm(i) * Atn(1) * 8) / 3 * 2
133.             sample1 = sample1 * Exp(-t * L) / 3 * 2
134.  
135.             t = t + 1 / _SndRate
136.  
137.             If akk = 1 Then
138.                 sample2 = Sin(t * fm(i + int1) * Atn(1) * 8) / 3 * 2
139.                 sample2 = sample2 * Exp(-t * L) / 3 * 2
140.                 sample1 = (sample1 + sample2) / 2
141.  
142.                 '_SndRaw sample2
143.                 't = t + 1 / _SndRate
144.                 sample3 = Sin(t * fm(i + int2) * Atn(1) * 8) / 3 * 2
145.                 sample3 = sample3 * Exp(-t * L) / 3 * 2
146.                 sample1 = (sample1 + sample3) / 2
147.                 '_SndRaw sample
148.                 't = t + 1 / _SndRate
149.             End If
150.             If p = 1 Then sample1 = 0
151.             _SndRaw sample1
152.             RawMusic(rwi) = sample1
153.             rwi = rwi + 1
154.  
155.             If rwi > UBound(RawMusic) Then
156.                 Print "Sound generated, saving to file generated.wav"
157.                 _Delay .5
158.                 SAVESOUND8S Left, Right, "generated.wav"
159.                 _MemFree Left
160.                 _MemFree Right
161.                 Erase RawMusic
162.                 System
163.             End If
164.         Loop
165.  
166.  
167.     Loop While t < L 'play for l seconds
168.  
169.     Do While _SndRawLen > 0 'Finish any left over queued sound!
170.     Loop
171.     _SndRawDone
172.  
173.  
174. Loop While in = ""
175.  
176.  
177.  
178.  
179.  
180.  
181.  
182.  
183.  
184.  
185. Sub SAVESOUND8S (Left As _MEM, Right As _MEM, file As String) 'Left and Right memory blocks contains value -1 to 1 (_SNDRAW compatible)
186.  
187.     Size = OFFSET_to_I64(Left.SIZE) 'convertion is used for WAV file header, becuse offset value can not be used directly
188.  
189.     Type head8
190.         chunk As String * 4 '       4 bytes  (RIFF)
191.         size As Long '              4 bytes  (file size)
192.         fomat As String * 4 '       4 bytes  (WAVE)
193.         sub1 As String * 4 '        4 bytes  (fmt )
194.         subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
195.         format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
196.         channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
197.         rate As Long '              4 bytes  (sample rate, standard is 44100)
198.         ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
199.         Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
200.         Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
201.         subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
202.         lenght As Long '            4 bytes  Data block size
203.     End Type '                     44 bytes  total
204.     Dim H8 As head8
205.     ch = FreeFile
206.  
207.     H8.chunk = "RIFF"
208.     H8.size = 44 + Size / 2
209.  
210.     H8.fomat = "WAVE"
211.     H8.sub1 = "fmt "
212.     H8.subchunksize = 16
213.     H8.format = 1
214.     H8.channels = 2
215.     H8.rate = 44100
216.     H8.ByteRate = 44100 * 2 * 8 / 8
217.     H8.Block = 2
218.     H8.Bits = 8
219.     H8.subchunk2 = "data"
220.     H8.lenght = Size / 2
221.     If _FileExists(file$) Then Kill file$
222.  
223.     Open file$ For Binary As #ch
224.     Put #ch, , H8
225.  
226.     Dim LeftChannel8 As _Byte, RightChannel8 As _Byte, RawLeft As Single, RawRight As Single
227.     Dim Recalc As _MEM, size As _Offset
228.  
229.     size = Left.SIZE 'now this value is for memory size used by SINGLE ARRAY - WAV 8bit need 1 byte for 1 channel and 1 sample
230.  
231.     'recalculate audiodata to file - byte - values
232.  
233.     Recalc = _MemNew(size / 2) 'this is value used by WAV - size is 4 byte per sample, we recording stereo (2 x 1 byte) therefore is this divided by 2
234.  
235.     start& = 0: LRO& = 0
236.     Do Until start& = Left.SIZE
237.         RawLeft = _MemGet(Left, Left.OFFSET + start&, Single)
238.         RawRight = _MemGet(Right, Right.OFFSET + start&, Single)
239.  
240.         LeftChannel8 = 128 - RawLeft * 128
241.         RightChannel8 = 128 - RawRight * 128
242.  
243.         _MemPut Recalc, Recalc.OFFSET + s&, LeftChannel8
244.         _MemPut Recalc, Recalc.OFFSET + s& + 1, RightChannel8
245.         s& = s& + 2
246.         start& = start& + 4
247.     Loop
248.  
249.     'write audio data to file
250.  
251.     WAVeRAW$ = Space$(s&)
252.     _MemGet Recalc, Recalc.OFFSET, WAVeRAW$
253.     Put #ch, , WAVeRAW$
254.  
255.     'erase memory
256.     _MemFree Recalc
257.     WAVeRAW$ = ""
258.     Close ch
259. End Sub
260.  
261. Function OFFSET_to_I64 (value As _Offset)
262.     Dim m As _MEM
263.     $If 32BIT Then
264.         DIM num AS LONG
265.         m = _MEM(num)
266.         _MEMPUT m,m.offset, value
267.         Offset_to_i64 = num
268.         _MEMFREE m
269.     $Else
270.         Dim num As _Integer64
271.         m = _Mem(num)
272.         _MemPut m, m.OFFSET, value
273.         OFFSET_to_I64 = num
274.         _MemFree m
275.     $End If
276. End Function
277.  

[Petr]

Nicely done. It seems, it works as expected :)