Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - chlorophyll-zz

Pages: [1]
1
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  

2
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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. ;-)

3
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  

4
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.

5
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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!

6
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  

7
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  


8
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  

9
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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 ;-)

10
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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!

11
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  

12
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  

13
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.

14
Programs / Re: Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.


15
Programs / Random Melodies and Chords (first complete and second rewrite - Bug Question)
« 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.  

Pages: [1]