Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: chlorophyll-zz on September 17, 2021, 12:20:53 pm

Title: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 17, 2021, 12:20:53 pm
I have wrote a Program that Generates Melodies and Chords (in F-Major Intervals).
Most of the variable names come from Geman, but I translated the Prints to english.
How you like this? (Modifications are always welcome)

Code: QB64: [Select]
  6. Dim tonmat(30) As Integer
  7. Dim diff(30) As Integer
  9. Dim m(28) As String:
  10. m(1) = "V50O1C": m(2) = "V50O1D": m(3) = "V50O1E": m(4) = "V40O1F": m(5) = "V40O1G": m(6) = "V40O1A": m(7) = "V40O1B"
  11. m(8) = "V30O2C": m(9) = "V30O2D": m(10) = "V30O2E": m(11) = "V20O2F": m(12) = "V20O2G": m(13) = "V20O2A": m(14) = "V20O2B"
  12. m(15) = "V20O3C": m(16) = "V20O3D": m(17) = "V10O3E": m(18) = "V10O3F": m(19) = "V10O3G": m(20) = "V10O3A": m(21) = "V10O3B"
  13. Dim lm(7) As Integer
  14. lm(1) = 1: lm(2) = 2: lm(3) = 4: lm(4) = 8: lm(5) = 16: lm(6) = 32: lm(7) = 64
  15.  
  17. Print "<<<***---Welcome to Melodies and Chords v0.0.4beta by chlorophyll-zz---***>>>"
  19. Print "Values: Default in brackets,"
  20. Print "For default press Enter."
  21. Print "Were starting ;-)"
  23. start:
  25. Input "Automatic or Manual Mode? a/m (a)"; auto
  26. If auto <> "m" Then auto = "a"
  27. If auto = "a" Then Print "Automatic Mode" Else Print "Manual Mode"
  29. If auto = "m" Then
  30.     Input "Lowest Basetone? (C1 to B2) 1-14(1)"; minton: If minton < 1 Or minton > 14 Then minton = 1
  31.     Print
  32.     Input "Highest Basetone? (C1 to B2) 1-14(14)"; maxton: If maxton < 1 Or maxton > 14 Then maxton = 14
  33.     Print
  35. If auto = "a" Then
  36.     minton = 1
  37.     maxton = 14
  39. Print "Basetone from "; Mid$(m(minton), 5, 3); " to "; Mid$(m(maxton), 5, 3)
  42. If auto = "m" Then
  43.     Print "Maximum Duration of Tones? 1/ 1-2-4-8-16"
  44.     Input "                              1 2 3 4  5  1-6 (2) "; minlang
  45.     Print
  46.     If minlang < 1 Or minlang > 5 Then minlang = 2
  47.  
  48.     Print "Minimum Duration of Tones? 1/ 1-2-4-8-16"
  49.     Input "                              1 2 3 4  5  1-6 (4) "; maxlang
  50.     Print
  51.     If maxlang < 1 Or maxlang > 5 Then maxlang = 4
  53. If auto = "a" Then
  54.     minlang = 2
  55.     maxlang = 4
  57. Print "Duration 1/" + LTrim$(Str$(lm(minlang))) + " to 1/"; LTrim$(Str$(lm(maxlang)))
  60. If auto = "m" Then
  61.     Dim aws As String
  62.     Input "How much Chords Possibility in %? 0-100(25)"; aws: If aws = "" Or Val(aws) > 100 Then aws = "25"
  63.     Print
  64.     proz = Val(aws)
  66. If auto = "a" Then proz = 25
  67. Print LTrim$(Str$(proz)) + "% Chords Possibility"
  70. If auto = "m" Then
  71.     Input "1. Interval from Basetone? 1-7? (C-E=2) (2)"; intmin: If intmin < 1 Or intmin > 7 Then intmin = 2
  72.     Print
  73.     Input "2. Interval from Basetone? 1-7? (C-G=4) (4)"; intmax: If intmax < 1 Or intmax > 7 Then intmax = 4
  74.     Print
  76. If auto = "a" Then
  77.     intmin = 2
  78.     intmax = 4
  80. Print "1. Interval"; intmin; "Tones from Basetone, 2. Interval"; intmax; "Tones from Basetone"
  83.  
  84. debug = 0
  86.     anfang = anfang + 1
  87.     If anfang = 1 Then
  88.         For i = 20 To 1 Step -1
  89.             tonmat(i) = CInt(Rnd * (maxton - minton)) + minton
  90.             If debug = 1 Then Print ; Str$(i) + ". Tone:" + Str$(tonmat(i)) + ",";
  91.             diff(i) = tonmat(i) - tonmat(i + 1)
  92.             If debug = 1 Then Print "Difference " + Str$(i); ". "; diff(i)
  93.         Next i
  94.  
  95.     End If
  96.  
  97.     t = CInt(Rnd * (maxton - minton)) + minton
  98.     If debug = 1 And (t < 1 Or t > 28) Then Print "Tone below 1 or over 28 t="; t: Input t
  99.     n = m(t)
  100.  
  101.     l = CInt(Rnd * (maxlang - minlang)) + minlang
  102.     If debug = 1 And (l < 1 Or l > 7) Then Print "Duration below 1 or over 7 l="; l: Input l
  103.  
  104.  
  105.     lt = lm(l)
  106.  
  107.     rn = Rnd
  108.     If rn < (proz / 100) Then
  109.         akk = 1
  110.         n = n + "," + m(t + intmin) + "," + m(t + intmax)
  111.     End If
  112.  
  113.     If akk = 1 And l >= minlang + 1 And Rnd * .66 >= (proz / 100) Then
  114.         lt = lm(minlang)
  115.     End If
  116.     akk = 0
  117.  
  118.     If rn > (proz / 100) Then n = m(t)
  119.  
  120.     tone = "L" + LTrim$(Str$(lt)) + n
  121.  
  122.     z = z + 1
  123.     If z = 1 Then
  124.         Print "<<<*-For Restart press n-*>>>"
  125.         Print
  126.     End If
  127.     If z = 21 Then z = 0
  128.  
  129.     Print "Duration: 1/" + LTrim$(Str$(lt)) + Chr$(9) + "Note(s): ";
  130.     If Len(n) > 6 Then Print ; Mid$(n, 5, 2) + ", " + Mid$(n, 12, 2) + ", "; Mid$(n, 19, 2)
  131.     If Len(n) = 6 Then Print ; Mid$(n, 5, 2)
  132.     'V25O1C,V25O1G,V25A1
  133.     Print
  134.     Play tone
  135.  
  136.  
  137.  
  138.     For i = 20 To 1 Step -1
  139.         tonmat(i) = tonmat(i - 1)
  140.         If i = 1 Then tonmat(i) = t
  141.         If debug = 1 Then Print ; Str$(i) + ". Tone:" + Str$(tonmat(i)) + ",";
  142.         diff(i) = tonmat(i) - tonmat(i + 1)
  143.         If debug = 1 Then Print "Difference " + Str$(i); ". "; diff(i)
  144.     Next i
  145.  
  146.     If debug = 1 Then Sleep
  147.  
  148.     x = _KeyHit
  149.     If x Then
  150.         If x = -110 Then
  151.             x = 0
  152.             GoTo start:
  153.         End If
  154.     End If
  156.  

I have also rewrote the Program to have FM-Synth, because a tester suggested that.
First the Program did run as expected but then I edited something I forgot, and the Chords are now sounding garbled.
I think something is wrong about _SNDRAW or _SNDRAWLEN .
Could you have a quick look? Thank you in advance.

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

Are you talking about slight buzz I am getting on chords or do I have too many crumbs in/on my speakers?

Sorry don't know much about sound Petr pretty good and Dav, speaking of whom have you checked this out?
https://www.qb64.org/forum/index.php?topic=2563.0
 
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 17, 2021, 01:21:13 pm
Quote from: bplus on September 17, 2021, 12:31:19 pm
Are you talking about slight buzz I am getting on chords or do I have too many crumbs in/on my speakers?
Yes, the Buzz is the problem.

I looked in the Program you suggested, and that Program uses a slightly different method, _SNDPLAY, to play the sound of the Drum-Machine.
My Program uses _SNDRAW to generate the sound waves sample by sample, which it does obviously wrong in some way.

Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: bplus on September 17, 2021, 01:26:48 pm
Here's a good reference, Fellippe's tut on sound, there is something new to QB64 about capturing wave patterns:
https://www.qb64.org/forum/index.php?topic=3919.0
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 17, 2021, 01:50:49 pm
Quote from: bplus on September 17, 2021, 01:26:48 pm
Here's a good reference, Fellippe's tut on sound, there is something new to QB64 about capturing wave patterns:
https://www.qb64.org/forum/index.php?topic=3919.0
Thank you. I saw the Video a few days ago and that was the reason I discovered FM Synth Sample generation with _SNDRAW.
For the Video part with _SNDRAW, he basically covers the Example code from _SNDRAW in the Wiki,
which I also modified to get the samples. I think I will have to investigate further what it takes to generate a chord,
because I think I have made somehow a wrong assumption that I could just play the _SNDRAW samples after another to generate the Chords.
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 17, 2021, 02:20:32 pm
I think I discovered a bug. Even with a slighly modified example code from _SNDRAW Wiki, the buzz is there:
The Problem is not present with 2 Samples, but appears after 3 Samples and persists with any new Sample that you play after another.

Code: QB64: [Select]
  1. t = 0
  2. tmp$ = "Sample = ##.#####   Time = ##.#####"
  3. Locate 1, 60: Print "Rate:"; _SndRate
  5.     'queue some sound
  6.     Do While _SndRawLen < 3 'you may wish to adjust this
  7.         sample = Sin(t * 440 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ï€)
  8.         sample = sample * Exp(-t * 3) 'fade out eliminates clicks after sound
  9.         _SndRaw sample
  10.         t = t + 1 / _SndRate 'sound card sample frequency determines time
  11.         sample = Sin(t * 220 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ï€)
  12.         sample = sample * Exp(-t * 3) 'fade out eliminates clicks after sound
  13.         _SndRaw sample
  14.         t = t + 1 / _SndRate
  15.         sample = Sin(t * 220 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ï€)
  16.         sample = sample * Exp(-t * 3) 'fade out eliminates clicks after sound
  17.         _SndRaw sample
  18.         t = t + 1 / _SndRate
  19.  
  20.     Loop
  21.  
  22.     'do other stuff, but it may interrupt sound
  23.     Locate 1, 1: Print Using tmp$; sample; t
  24. Loop While t < 3.0 'play for 3 seconds
  25.  
  26. Do While _SndRawLen > 0 'Finish any left over queued sound!
  29.  
  30.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 17, 2021, 02:26:14 pm
I have edited the code, so it only play two tones in a chord (now without buzz).
I suggest 100% Chords possibility for maximal comfort, thats why I made it default ;-)

Code: QB64: [Select]
  1. Dim fm(88) As Double
  3. Dim tn(88) As String
  7.  
  8. Print "Welcone to Random Tones and Chords Generator v0.1b"
  10. Input "Please specify Chord possibility in % (25)"; uaw$
  11. If uaw$ = "" Or Val(uaw$) < 0 Or Val(uaw$) > 100 Then
  12.     aw = 100
  13. Else aw = Val(uaw$)
  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
  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
  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.  
  72.  
  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.     t = 1 / _SndRate
  85.     If akk = 1 Then
  86.         Print "Length 1/"; LTrim$(Str$(lr)); " Tone:"; tn(i); "+"; tn(i + int1) '; "+"; tn(i + 7)
  87.     Else Print "Length 1/"; LTrim$(Str$(lr)); " Tone:"; tn(i)
  88.     End If
  89.     Do
  90.         'queue some sound
  91.         Do While t < l 'you may wish to adjust this
  92.             sample = Sin(t * fm(i) * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ï€)
  93.             sample = sample * Exp(-t * l) 'fade out eliminates clicks after sound
  94.             _SndRaw sample
  95.             t = t + 1 / _SndRate 'sound card sample frequency determines time
  96.  
  97.             If akk = 1 Then
  98.                 sample2 = Sin(t * fm(i + int1) * Atn(1) * 8)
  99.                 sample2 = sample2 * Exp(-t * l)
  100.                 _SndRaw sample2
  101.                 t = t + 1 / _SndRate
  102.                 'sample = Sin(t * fm(i + int2) * Atn(1) * 8)
  103.                 'sample = sample3 * Exp(-t * l)
  104.                 '_SndRaw sample
  105.                 't = t + 1 / _SndRate
  106.             End If
  107.  
  108.         Loop
  109.  
  110.  
  111.     Loop While t < l 'play for l seconds
  112.  
  113.     Do While _SndRawLen > 0 'Finish any left over queued sound!
  114.     Loop
  115.  
  116.  
  117.     in = InKey$
  118. Loop While in = ""
  119.  
  120.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 17, 2021, 02:42:53 pm
Hi. Try, if this is repaired or is still broken:

Code: QB64: [Select]
  1. DIM fm(88) AS DOUBLE
  3. DIM tn(88) AS STRING
  6.  
  7. PRINT "Welcone to Random Tones and Chords Generator v0.1b"
  9. INPUT "Please specify Chord possibility in % (25)"; uaw$
  10. IF uaw$ = "" OR VAL(uaw$) < 0 OR VAL(uaw$) > 100 THEN
  11.     aw = 25
  12. ELSE aw = VAL(uaw$)
  14. PRINT "Chords possibility:"; aw; "%"
  15. bpm = 120
  16. 'interval 1 and 2 (semitones)
  17. int1 = 2
  18. int2 = 7
  19. 'interval possibility percent
  20. 'aw = 25
  21. 'tone minimum and maximum
  22. tmin = 35
  23. tmax = 47
  24. 'lengths min and max
  25. lmin = 2
  26. lmax = 4
  27. 'fill the tone names
  28. FOR i = 1 TO 88
  29.     f = ((2 ^ ((i - 49) / 12)) * 440)
  30.     fm(i) = f
  31.     SELECT CASE i MOD 12
  32.         CASE 1: tn(i) = "A"
  33.         CASE 2: tn(i) = "A#"
  34.         CASE 3: tn(i) = "B"
  35.         CASE 4: tn(i) = "C"
  36.         CASE 5: tn(i) = "C#"
  37.         CASE 6: tn(i) = "D"
  38.         CASE 7: tn(i) = "D#"
  39.         CASE 8: tn(i) = "E"
  40.         CASE 9: tn(i) = "F"
  41.         CASE 10: tn(i) = "F#"
  42.         CASE 11: tn(i) = "G"
  43.         CASE 0: tn(i) = "G#"
  44.     END SELECT
  45.     'Select Case Int(i / 12)
  46.     '    Case 0: tn(i) = tn(i) + "0"
  47.  
  48.     'End Select
  49.     'DEBUG
  50.     'Print f; tn(i)
  51.     'If i > 24 Then Sleep
  53.  
  54. 'delete all sharp tones
  55. FOR i = 1 TO 88
  56.     IF MID$(tn(i), 2, 1) = "#" THEN
  57.         tn(i) = tn(i - 1)
  58.         fm(i) = fm(i - 1)
  59.     END IF
  61. 'DEBUG fm(49)="A"
  62. 'Print fm(49)
  63.  
  64. 'fill the lengths
  65. FOR i = 1 TO 7
  66.     lm(i) = 2 ^ i / 2
  67.     'DEBUG
  68.     'Print lm(i)
  69.  
  71.  
  73.     'tones between tmin and tmax
  74.     i = CINT((RND * (tmax - tmin)) + tmin)
  75.  
  76.     lr = lm(CINT(RND * (lmax - lmin)) + lmin) 'Length out of the lenght fields between 2 and 4
  77.     l = 1 / lr * 60 / bpm * 4 'Lenght is parts of a second from the length fields multiplied by bpm
  78.  
  79.     IF RND < aw / 100 THEN
  80.         akk = 1
  81.     ELSE akk = 0
  82.     END IF
  83.     t = 0
  84.     akk = 1
  85.     IF akk = 1 THEN
  86.         PRINT "Length 1/"; LTRIM$(STR$(lr)); " Tone:"; tn(i); "+"; tn(i + 4); "+"; tn(i + 7)
  87.     ELSE PRINT "Length 1/"; LTRIM$(STR$(lr)); " Tone:"; tn(i)
  88.     END IF
  89.     DO
  90.         'queue some sound
  91.         DO WHILE t < l 'you may wish to adjust this
  92.             sample = SIN(t * fm(i) * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  93.             sample = sample * EXP(-t * l) 'fade out eliminates clicks after sound
  94.             '_SNDRAW sample
  95.             t = t + 1 / _SNDRATE 'sound card sample frequency determines time
  96.  
  97.             IF akk = 1 THEN
  98.                 sample2 = SIN(t * fm(i + int1) * ATN(1) * 8)
  99.                 sample2 = sample2 * EXP(-t * l)
  100.                 '   _SNDRAW sample2
  101.                 sample = (sample + sample2) / 2
  102.  
  103.                 sample3 = SIN(t * fm(i + int2) * ATN(1) * 8)
  104.                 sample3 = sample3 * EXP(-t * l)
  105.                 '   _SNDRAW sample3
  106.  
  107.                 sample = (sample + sample3) / 2
  108.  
  109.                 t = t + 2 / _SNDRATE
  110.             END IF
  111.  
  112.             _SNDRAW sample
  113.  
  114.         LOOP
  115.  
  116.  
  117.     LOOP WHILE t < l 'play for l seconds
  118.  
  119.     DO WHILE _SNDRAWLEN < 0 'Finish any left over queued sound!
  120.     LOOP
  121.  
  122.     in = INKEY$
  123. LOOP WHILE in = ""
  124.  
  125.  
  126.  

Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 17, 2021, 02:52:26 pm
Very nice work, this all! Good job! I like it!
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 17, 2021, 03:15:19 pm
I also encountered problems with slowing down or distorting the sound if I called the _SNDRAW command multiple times in a row. In order for the audio data to be transmitted as I intended, I first mix it using a mathematical average, and only finally, when the data stream is ready, I pass it all at once to the _SNDRAW command. This is the most reliable way to achieve the expected result.
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 17, 2021, 03:21:14 pm
Quote from: Petr on September 17, 2021, 02:42:53 pm
Hi. Try, if this is repaired or is still broken:

The tones are now double the frequency and half the duration as they should.
But the Buzz is gone.

I edited your edits in to the example code. Is this right?
I think the t is only added 1/_SNDRATE because only one sample gets played.

This produces one tone, I think of 440 Hz.

Code: QB64: [Select]
  1. t = 0
  2. tmp$ = "Sample = ##.#####   Time = ##.#####"
  3. Locate 1, 60: Print "Rate:"; _SndRate
  5.     'queue some sound
  6.     Do While _SndRawLen < 3 'you may wish to adjust this
  7.         sample1 = Sin(t * 440 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ï€)
  8.         sample1 = sample1 * Exp(-t * 3) 'fade out eliminates clicks after sound
  9.         '_SndRaw sample
  10.         t = t + 1 / _SndRate 'sound card sample frequency determines time
  11.  
  12.         sample2 = Sin(t * 110 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ï€)
  13.         sample2 = sample2 * Exp(-t * 3) 'fade out eliminates clicks after sound
  14.         '_SndRaw sample
  15.         't = t + 1 / _SndRate
  16.  
  17.         sample1 = (sample1 + sample2) / 2
  18.  
  19.         sample3 = Sin(t * 220 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ï€)
  20.         sample3 = sample3 * Exp(-t * 3) 'fade out eliminates clicks after sound
  21.  
  22.         sample1 = (sample1 + sample3) / 2
  23.  
  24.         't = t + 1 / _SndRate
  25.         _SndRaw sample1
  26.     Loop
  27.  
  28.  
  29.     'do other stuff, but it may interrupt sound
  30.     Locate 1, 1: Print Using tmp$; sample; t
  31. Loop While t < 3.0 'play for 3 seconds
  32.  
  33. Do While _SndRawLen > 0 'Finish any left over queued sound!
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 17, 2021, 04:11:16 pm
You are very right. So I'm trying everything here now. Well, I think I've found a solution. Also, thanks to that, I finally understood what the _SNDRAWOPEN command was doing, which I had quietly trodden around in the past and couldn't understand. And now your clear code makes perfect sense to him. This ensures that the individual sounds do not mix. This program should work properly, it shows what I tried. I think that's what you're looking for.

Code: QB64: [Select]
  1. t = 0
  2. tmp$ = "Sample = ##.#####   Time = ##.#####"
  3. LOCATE 1, 60: PRINT "Rate:"; _SNDRATE
  4.  
  8.  
  10.     'queue some sound
  11.     DO UNTIL t >= 3 'you may wish to adjust this
  12.         sample1 = SIN(t * 440 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  13.         sample1 = sample1 * EXP(-t * 3) 'fade out eliminates clicks after sound
  14.         '_SndRaw sample
  15.         ' t = t + 1 / _SNDRATE 'sound card sample frequency determines time
  16.  
  17.         sample2 = SIN(t * 110 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  18.         sample2 = sample2 * EXP(-t * 3) 'fade out eliminates clicks after sound
  19.         '_SndRaw sample
  20.         ' t = t + 1 / _SndRate
  21.  
  22.         '  sample1 = (sample1 + sample2) / 2
  23.  
  24.         sample3 = SIN(t * 220 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  25.         sample3 = sample3 * EXP(-t * 3) 'fade out eliminates clicks after sound
  26.  
  27.         ' sample1 = (sample1 + sample3) / 2
  28.  
  29.         t = t + 1 / _SNDRATE
  30.         _SNDRAW sample1, , S1
  31.         _SNDRAWDONE
  32.         _SNDRAW sample2, , S2
  33.         _SNDRAWDONE
  34.         _SNDRAW sample3, , S3
  35.         _SNDRAWDONE
  36.  
  37.         '   _SNDRAW sample1
  38.         '   _SNDRAW sample2
  39.         '   _SNDRAW sample3
  40.  
  41.         LOCATE 1, 1: PRINT USING tmp$; sample; t
  42.  
  43.  
  44.     LOOP
  45.  
  46.     _SNDCLOSE S1
  47.     _SNDCLOSE S2
  48.     _SNDCLOSE S3
  49.  
  50.     'do other stuff, but it may interrupt sound
  51.     LOCATE 1, 1: PRINT USING tmp$; sample; t
  52. LOOP WHILE t < 3.0 'play for 3 seconds
  53.  
  54. DO WHILE _SNDRAWLEN > 0 'Finish any left over queued sound!
  57.  
  58.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: bplus on September 17, 2021, 05:30:22 pm
Did that fix the melodies?
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 18, 2021, 12:14:57 am
Quote from: Petr on September 17, 2021, 04:11:16 pm
Well, I think I've found a solution.
I cant test right now, but this looks very promising. I will test and work your example code in my Program and write back to you. Later ;-)
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 19, 2021, 01:24:15 am
Quote from: Petr on September 17, 2021, 04:11:16 pm
Well, I think I've found a solution.

...

Code: QB64: [Select]
  1. t = 0
  2. tmp$ = "Sample = ##.#####   Time = ##.#####"
  3. LOCATE 1, 60: PRINT "Rate:"; _SNDRATE
  4.  
  8.  
  10.     'queue some sound
  11.     DO UNTIL t >= 3 'you may wish to adjust this
  12.         sample1 = SIN(t * 440 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  13.         sample1 = sample1 * EXP(-t * 3) 'fade out eliminates clicks after sound
  14.         '_SndRaw sample
  15.         ' t = t + 1 / _SNDRATE 'sound card sample frequency determines time
  16.  
  17.         sample2 = SIN(t * 110 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  18.         sample2 = sample2 * EXP(-t * 3) 'fade out eliminates clicks after sound
  19.         '_SndRaw sample
  20.         ' t = t + 1 / _SndRate
  21.  
  22.         '  sample1 = (sample1 + sample2) / 2
  23.  
  24.         sample3 = SIN(t * 220 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  25.         sample3 = sample3 * EXP(-t * 3) 'fade out eliminates clicks after sound
  26.  
  27.         ' sample1 = (sample1 + sample3) / 2
  28.  
  29.         t = t + 1 / _SNDRATE
  30.         _SNDRAW sample1, , S1
  31.         _SNDRAWDONE
  32.         _SNDRAW sample2, , S2
  33.         _SNDRAWDONE
  34.         _SNDRAW sample3, , S3
  35.         _SNDRAWDONE
  36.  
  37.         '   _SNDRAW sample1
  38.         '   _SNDRAW sample2
  39.         '   _SNDRAW sample3
  40.  
  41.         LOCATE 1, 1: PRINT USING tmp$; sample; t
  42.  
  43.  
  44.     LOOP
  45.  
  46.     _SNDCLOSE S1
  47.     _SNDCLOSE S2
  48.     _SNDCLOSE S3
  49.  
  50.     'do other stuff, but it may interrupt sound
  51.     LOCATE 1, 1: PRINT USING tmp$; sample; t
  52. LOOP WHILE t < 3.0 'play for 3 seconds
  53.  
  54. DO WHILE _SNDRAWLEN > 0 'Finish any left over queued sound!
  57.  
  58.  

This produces only the last Sample (3) of 220Hz, a bit distorted, unfortunately.
You can hear that yourself when you compare the sound of your code 
to the first and second _sndraw commented out.:

Code: QB64: [Select]
  1. t = 0
  2. tmp$ = "Sample = ##.#####   Time = ##.#####"
  3. LOCATE 1, 60: PRINT "Rate:"; _SNDRATE
  4.  
  8.  
  10.     'queue some sound
  11.     DO UNTIL t >= 3 'you may wish to adjust this
  12.         sample1 = SIN(t * 440 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  13.         sample1 = sample1 * EXP(-t * 3) 'fade out eliminates clicks after sound
  14.         '_SndRaw sample
  15.         ' t = t + 1 / _SNDRATE 'sound card sample frequency determines time
  16.  
  17.         sample2 = SIN(t * 110 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  18.         sample2 = sample2 * EXP(-t * 3) 'fade out eliminates clicks after sound
  19.         '_SndRaw sample
  20.         ' t = t + 1 / _SndRate
  21.  
  22.         '  sample1 = (sample1 + sample2) / 2
  23.  
  24.         sample3 = SIN(t * 220 * ATN(1) * 8) '440Hz sine wave (t * 440 * 2?)
  25.         sample3 = sample3 * EXP(-t * 3) 'fade out eliminates clicks after sound
  26.  
  27.         ' sample1 = (sample1 + sample3) / 2
  28.  
  29.         t = t + 1 / _SNDRATE
  30.         '_SNDRAW sample1, , S1
  31.         '_SNDRAWDONE
  32.         '_SNDRAW sample2, , S2
  33.         '_SNDRAWDONE
  34.         _SNDRAW sample3, , S3
  35.         _SNDRAWDONE
  36.  
  37.         '   _SNDRAW sample1
  38.         '   _SNDRAW sample2
  39.         '   _SNDRAW sample3
  40.  
  41.         LOCATE 1, 1: PRINT USING tmp$; sample; t
  42.  
  43.  
  44.     LOOP
  45.  
  46.     _SNDCLOSE S1
  47.     _SNDCLOSE S2
  48.     _SNDCLOSE S3
  49.  
  50.     'do other stuff, but it may interrupt sound
  51.     LOCATE 1, 1: PRINT USING tmp$; sample; t
  52. LOOP WHILE t < 3.0 'play for 3 seconds
  53.  
  54. DO WHILE _SNDRAWLEN > 0 'Finish any left over queued sound!
  57.  
  58.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 19, 2021, 08:12:32 am
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.
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 19, 2021, 08:15:51 am
You can try also some combinations als:

        _SNDRAW sample1, , S3
        '_SNDRAWDONE
        _SNDRAW sample2, , S3
        '_SNDRAWDONE
        _SNDRAW sample3, , S1
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 20, 2021, 04:14:02 am
Quote from: Petr on September 19, 2021, 08:12:32 am
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.  
  8.  
  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!
  45.  
  46.  
  47.  

Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 20, 2021, 05:39:05 am
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
  3. Dim tn(88) As String
  7.  
  8. Print "Welcone to Random Tones and Chords Generator v0.1b"
  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$)
  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
  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
  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.  
  72.  
  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
  120.  
  121.     in = InKey$
  122. Loop While in = ""
  123.  
  124.  
  125.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: bplus on September 20, 2021, 11:43:39 am
Ah, you've cleaned the crumbs from my speaker sounds better. :)
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 24, 2021, 01:49:02 pm
@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
  4. DIM tn(88) AS STRING
  8. DIM Left AS _MEM, Right AS _MEM
  9.  
  10.  
  11.  
  12.  
  13. PRINT "Welcone to Random Tones and Chords Generator v0.1b"
  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$)
  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
  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
  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.  
  84.  
  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
  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
  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
  249.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 24, 2021, 03:32:13 pm
Quote from: Petr on September 24, 2021, 01:49:02 pm
@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!
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 24, 2021, 03:43:11 pm
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).
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 25, 2021, 05:04:56 am
Quote from: Petr on September 24, 2021, 03:43:11 pm
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.
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 25, 2021, 05:15:07 am
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.
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 25, 2021, 05:22:40 am
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
  3. Dim tn(88) As String
  7. Dim Left As _MEM, Right As _MEM
  8.  
  9.  
  10.  
  11.  
  12. Print "Welcone to Random Tones and Chords Generator v0.1b"
  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$)
  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$)
  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$)
  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
  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
  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.  
  99.  
  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
  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
  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
  264.  
  265.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 25, 2021, 05:32:15 am
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.
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 25, 2021, 07:48:59 am
Quote from: Petr on September 25, 2021, 05:32:15 am
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. ;-)
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: chlorophyll-zz on September 25, 2021, 07:55:23 am
Quote from: Petr on September 25, 2021, 05:32:15 am
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
  3. Dim tn(88) As String
  7. Dim Left As _MEM, Right As _MEM
  8.  
  9.  
  10.  
  11.  
  12. Print "Welcone to Random Tones and Chords Generator v0.1b"
  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$)
  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$)
  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$)
  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$)
  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
  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
  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.  
  107.  
  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
  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
  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
  277.  
Title: Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
Post by: Petr on September 25, 2021, 08:21:29 am
Nicely done. It seems, it works as expected :)
Text Only | Text with Attachments