Raw Sound Creation Demo (cross-plattform)

Joakim Christiansen · Mon Apr 12, 2010 10:16 pm

Below this code you'll find my original post.
But here is the new and improved (cross-platform) code:

;Raw Sound Creation Demo
;By: Joakim L. Christiansen
;Version: 1.1

EnableExplicit

; Structure WAVEFORMATEX ;may need to uncomment on Linux or Mac
;   wFormatTag.w
;   nChannels.w
;   nSamplesPerSec.l
;   nAvgBytesPerSec.l
;   nBlockAlign.w
;   wBitsPerSample.w
;   cbSize.w
; EndStructure

Global format.WAVEFORMATEX

Procedure setWaveFormat(bitsPerSample=16,samplesPerSec=44100)
  format\wFormatTag = #WAVE_FORMAT_PCM
  format\nChannels = 1 ;mono
  format\wBitsPerSample = bitsPerSample ;8/16
  format\nSamplesPerSec =  samplesPerSec ;8000 Hz, 11025 Hz, 22050 Hz, and 44100 Hz
  format\nBlockAlign = (format\nChannels * format\wBitsPerSample) / 8 ;equal to the product of nChannels and wBitsPerSample divided by 8 (bits per byte).
  format\nAvgBytesPerSec = format\nSamplesPerSec * format\nBlockAlign ;equal to the product of nSamplesPerSec and nBlockAlign
EndProcedure
Procedure.l createTone(*address,volume.d,duration,frequency.d) ;returns needed size if address=0
  ;creates a triangle wave
  Protected sample.l, result
  Protected pos, dir, waveY.d, maxValue, centerValue
  Protected samplesPerHalfWave, waveIncrementValue.d, size
  Protected samplesSinceHalfWave, waveTop.d
  
  size = (format\nSamplesPerSec / 1000*duration) * format\wBitsPerSample / 8
  If *address = 0 ;return size needed
    ProcedureReturn size
  EndIf
  
  If format\wBitsPerSample = 8
    maxValue = 255
  ElseIf format\wBitsPerSample = 16
    maxValue = 65535
  EndIf
  centerValue = (maxValue/2)
  
  waveTop = volume/1000 * centerValue
  samplesPerHalfWave = (format\nSamplesPerSec / frequency) / 2
  waveIncrementValue = waveTop / samplesPerHalfWave
 
  For pos=0 To size
    If dir=0
      waveY + waveIncrementValue
    Else
      waveY - waveIncrementValue
    EndIf
    samplesSinceHalfWave + 1
    If samplesSinceHalfWave >= samplesPerHalfWave
      dir = dir!1 ;switch it
      samplesSinceHalfWave = 0
    EndIf
    
    If format\wBitsPerSample = 8
      sample = centerValue + waveY
      PokeA(*address+pos,sample)
    ElseIf format\wBitsPerSample = 16
      sample = waveY
      PokeW(*address+pos,sample)
      pos+1
    EndIf
  Next
EndProcedure
Procedure.l createToneEx(*address,volumeAtStart.d,volumeAtEnd.d,duration.d,frequencyAtStart.d,frequencyAtEnd.d=0,noiseAtStart.d=0,noiseAtEnd.d=0,backToStart=0) ;returns needed size if address=0
  ;creates a triangle wave with added effects
  Protected sample.l, result, pos, dir, waveY.d, maxValue, centerValue
  Protected samplesPerHalfWave.d, waveIncrementValue.d, size, samplesSinceHalfWave, waveTop.d
  Protected frequency.d, frequencyIncrementValue.d, noise.d, noiseIncrementValue.d, lastNoise.d, halfSize, loop, loops
  Protected waveYpos.d, volumeIncrementValue.d, volume.d
  volume = volumeAtStart
  frequency = frequencyAtStart
  noise = noiseAtStart
  
  size = (format\nSamplesPerSec / 1000*duration) * format\wBitsPerSample / 8
  If *address = 0 ;return size needed
    If backToStart
      ProcedureReturn size * 2
    Else
      ProcedureReturn size
    EndIf
  EndIf
  
  If format\wBitsPerSample = 8
    maxValue = 255
  ElseIf format\wBitsPerSample = 16
    maxValue = 65535
  EndIf
  centerValue = (maxValue/2)
  waveTop = centerValue
  
  samplesPerHalfWave = (format\nSamplesPerSec / frequency) / 2
  waveIncrementValue = waveTop / samplesPerHalfWave
  
  volumeIncrementValue = (volumeAtEnd - volumeAtStart) / size * format\wBitsPerSample/8
  frequencyIncrementValue = (frequencyAtEnd - frequencyAtStart) / size * format\wBitsPerSample/8
  noiseIncrementValue = (noiseAtEnd - noiseAtStart) / size * format\wBitsPerSample/8
  
  If backToStart: loops=1: EndIf
  For loop=0 To loops
    For pos=pos To size
      If volumeAtEnd
        volume + volumeIncrementValue
      EndIf
      If frequencyAtEnd
        frequency + frequencyIncrementValue
        samplesPerHalfWave = (format\nSamplesPerSec / frequency) / 2
        waveIncrementValue = waveTop / samplesPerHalfWave
      EndIf
      If noiseAtEnd
        noise + noiseIncrementValue
      EndIf
      
      If dir=0
        waveYpos + waveIncrementValue
      Else
        waveYpos - waveIncrementValue
      EndIf
      samplesSinceHalfWave + 1
      If samplesSinceHalfWave >= samplesPerHalfWave
        If dir=0
          waveYpos = waveTop
        Else
          waveYpos = -waveTop
        EndIf
        dir = dir!1 ;switch it
        samplesSinceHalfWave = 0
      EndIf
      
      waveY = waveYpos
      
      ;waveY = waveY*16
      ;waveY + Random(90000)

      
      If noiseAtStart
        If lastNoise >= noise; Random(noise) = 0
          Select 0
            Case 0: waveYpos = Random(maxValue)-centerValue
            Case 1: waveY = Random(maxValue)-centerValue
            ;Case 2: waveYpos = Random(maxValue) ; waveY + Random(90000)
          EndSelect
          lastNoise = 1
        Else
          lastNoise+1
        EndIf
      EndIf
      
      ;adjust volume
      waveY = volume/1000 * waveY

      If format\wBitsPerSample = 8
        sample = centerValue + waveY
        PokeA(*address+pos,sample)
      ElseIf format\wBitsPerSample = 16
        sample = waveY
        PokeW(*address+pos,sample)
        pos+1
      EndIf
    Next
    
    If backToStart ;morph back
      If volumeAtEnd
        volume    = volumeAtEnd
      EndIf
      If frequencyAtEnd
        frequency = frequencyAtEnd
      EndIf
      If noiseAtEnd
        noise     = noiseAtEnd
      EndIf
      volumeIncrementValue    = -volumeIncrementValue
      frequencyIncrementValue = -frequencyIncrementValue
      noiseIncrementValue     = -noiseIncrementValue
      size+size
    EndIf
  Next
EndProcedure

Procedure addWaveHeader(*address,dataSize,channels,samplesPerSec,blockAlign,bitsPerSample)
  ; RIFF Chunk
  PokeL(*address+ 0, 'FFIR')
  PokeL(*address+ 4, dataSize + 36)
  PokeL(*address+ 8, 'EVAW')
  ; FORMAT Chunk
  PokeL(*address+ 12, ' tmf')
  PokeL(*address+ 16, $0010)
  PokeW(*address+ 20, $01)
  PokeW(*address+ 22, channels)
  PokeL(*address+ 24, samplesPerSec)
  PokeL(*address+ 28, samplesPerSec * channels * (bitsPerSample / 8) )
  PokeW(*address+ 32, blockAlign)
  PokeW(*address+ 34, bitsPerSample)
  ; DATA Chunk
  PokeL(*address+ 36, 'atad')
  PokeL(*address+ 40, dataSize)
EndProcedure
Procedure catchTone(volume,duration,frequency)
  Protected *memory, id, size
  size = createTone(0,volume,duration,frequency) ;get size
  *memory = AllocateMemory(44+size)
  createTone(*memory+44,volume,duration,frequency) ;write wave data to memory
  addWaveHeader(*memory,size,format\nChannels,format\nSamplesPerSec,format\nBlockAlign,format\wBitsPerSample)
  id = CatchSound(#PB_Any,*memory)
  FreeMemory(*memory)
  ProcedureReturn id
EndProcedure
Procedure catchToneEx(volumeAtStart,volumeAtEnd,duration,frequencyAtStart,frequencyAtEnd=0,noiseAtStart=0,noiseAtEnd=0,backToStart=0)
  Protected *memory, id, size
  size = createToneEx(0,volumeAtStart,volumeAtEnd,duration,frequencyAtStart,frequencyAtEnd,noiseAtStart,noiseAtEnd,backToStart) ;get size
  *memory = AllocateMemory(44+size)
  createToneEx(*memory+44,volumeAtStart,volumeAtEnd,duration,frequencyAtStart,frequencyAtEnd,noiseAtStart,noiseAtEnd,backToStart) ;write wave data to memory
  addWaveHeader(*memory,size,format\nChannels,format\nSamplesPerSec,format\nBlockAlign,format\wBitsPerSample)
  id = CatchSound(#PB_Any,*memory)
  FreeMemory(*memory)
  ProcedureReturn id
EndProcedure

InitSound()
setWaveFormat(16,44100)
Define snd_explosion, snd_laser, snd_shoot, snd_pacman, snd_flying

snd_explosion = catchToneEx(1000,100,  1000,  50,20,  20,100)
snd_laser = catchToneEx(1000,100,  300,  1500,200)
snd_shoot = catchToneEx(1000,1,  500,  200,10,  1,10)
snd_pacman = catchToneEx(500,0,  100,  400,200, 0,0, #True)
snd_flying = catchToneEx(500,0,  200,  10,0, 5,10, #True)

PlaySound(catchToneEx(1000,100,  2000,  200,40, 0,0)):Delay(2000)
PlaySound(catchToneEx(1000,100,  2000,  10,200, 100,1 )):Delay(2000)
PlaySound(snd_flying): Delay(400)
PlaySound(snd_flying): Delay(400)
PlaySound(snd_flying): Delay(400)
PlaySound(snd_flying): Delay(400)
PlaySound(snd_pacman): Delay(200)
PlaySound(snd_pacman): Delay(200)
PlaySound(snd_explosion): Delay(1000)
PlaySound(snd_laser): Delay(300)
PlaySound(snd_laser): Delay(300)
PlaySound(snd_shoot): Delay(1000)
PlaySound(catchToneEx(1000,100,  2000,  200,10, 1,100 )):Delay(2000)

;Have fun! ;-)

Original post:

I and many others have always wanted to know more about how to do this, so when I found some nice Windows API functions by random which I could use (why are they so hard to find?) I just had to make a demo and show you guys.

It basically lets you define the analog signal sent to the speakers, more about that here:
http://en.wikipedia.org/wiki/Pulse-code_modulation

The API documentation:
http://msdn.microsoft.com/en-us/library ... 10%29.aspx

Another example (not mine) but for recording:
http://www.purebasic.fr/english/viewtop ... =12&t=7009
I also trimmed that example down if anyone wants it just say so. I plan making a voice recognition software actually.

I should probably explain some more, but.. we have Google, etc.

EDIT:
Would anyone want to have an old-school sound effects contest (recreating Commodore/Atari sounds, etc) ?
First entry in contest (me yes):
http://www.purebasic.fr/english/viewtop ... 23#p321423

Code: Select all

EnableExplicit

Structure tone
  frequency.l
  duration.l
EndStructure

Global hWo, outHdr.WAVEHDR, result
Global format.WAVEFORMATEX ;wave format info
Global outBufferLength = 1000000 ;1mb
Global NewList tone.tone()
Define i

Procedure.l randomEx(min,max)
  ProcedureReturn min+Random(max-min)
EndProcedure
Procedure.l minMax(value,min,max)
  If value > max
    ProcedureReturn max
  ElseIf value < min
    ProcedureReturn min
  Else
    ProcedureReturn value
  EndIf
EndProcedure
Procedure.s waveOutError(result)
  Protected error$ = Space(1000)
  waveOutGetErrorText_(result,@error$,1000)
  ProcedureReturn error$
EndProcedure
Procedure addTone(frequency,duration)
  AddElement(tone())
  tone()\frequency = frequency
  tone()\duration  = duration
EndProcedure
Procedure playTone(*outHdr.WAVEHDR,volume.d,frequency.d,length) ;volum 0-1000
  Protected sample.l, result
  Protected pos, dir, waveY.d = 0, maxValue, vol.d, centerValue
  Protected samplesPerHalfWave.d, waveIncrementValue.d
  
  samplesPerHalfWave = format\nSamplesPerSec / frequency
  length = (format\nSamplesPerSec / 1000*length) * format\wBitsPerSample / 8
  If format\wBitsPerSample = 8
    maxValue = 255
  ElseIf format\wBitsPerSample = 16
    maxValue = 65535
  EndIf
  centerValue = (maxValue/2)+1
  vol = volume/1000 * centerValue
  waveIncrementValue = vol / samplesPerHalfWave
  
  If length <= outBufferLength
    For pos=0 To length
      If dir = 1
        If waveY < vol
          waveY + waveIncrementValue
          If waveY >= vol
            dir = 0
          EndIf
        EndIf
      Else
        If waveY > -vol
          waveY - waveIncrementValue
          If waveY <= -vol
            dir = 1
          EndIf
        EndIf
      EndIf
      ;Debug sample
      If format\wBitsPerSample = 8
        sample = minMax(centerValue + waveY,0,maxValue) 
        PokeA(*outHdr\lpData+pos,sample)
      ElseIf format\wBitsPerSample = 16
        sample = waveY
        PokeW(*outHdr\lpData+pos,sample)
        pos+1
      EndIf
    Next
    
    *outHdr\dwBufferLength = length ;tell how much we wrote
    
    ;send to output buffer
    result = waveOutWrite_(hWo,@OutHdr,SizeOf(WAVEHDR))
    If result <> #MMSYSERR_NOERROR
      Debug waveOutError(result)
    EndIf
  Else
    Debug "error, length too big"
    Debug length
    Debug  *outHdr\dwBufferLength
  EndIf
EndProcedure
Procedure listOutDevices() ;run to enumerate devices if needed
  Protected cap.WAVEOUTCAPS, devices, deviceId
  devices = waveOutGetNumDevs_()
  If devices
    For deviceId=#WAVE_MAPPER To devices-1
      If waveOutGetDevCaps_(deviceId,@cap,SizeOf(WAVEOUTCAPS)) = #MMSYSERR_NOERROR
        Debug deviceId
        Debug PeekS(@cap\szPname) ;max 32 btw
      EndIf
    Next
  EndIf
EndProcedure
Procedure waCallback(hWi.l, uMsg.l, dwInstance.l, dwParam1.l, dwParam2.l)
  Protected *outHdr.WAVEHDR, byte.a, pos, sampleSize=1, x
  Select uMsg
    Case #WOM_OPEN
      Debug "open"
    Case #WOM_CLOSE
      Debug "close"
    Case #WOM_DONE
      ;Debug "done"
      *outHdr.WAVEHDR = dwParam1
      If NextElement(tone())
        playTone(@outHdr,500,tone()\frequency,tone()\duration)
      Else
        Debug "done playing"
      EndIf
  EndSelect
EndProcedure

format\wFormatTag = #WAVE_FORMAT_PCM
format\nChannels = 1 ;mono
format\wBitsPerSample = 16 ;8/16 
format\nSamplesPerSec =  44100 ;8000 Hz, 11025 Hz, 22050 Hz, and 44100 Hz
format\nBlockAlign = (format\nChannels * format\wBitsPerSample) / 8 ;equal to the product of nChannels and wBitsPerSample divided by 8 (bits per byte).
format\nAvgBytesPerSec = format\nSamplesPerSec * format\nBlockAlign ;equal to the product of nSamplesPerSec and nBlockAlign

result = waveOutOpen_(@hWo,#WAVE_MAPPER+1,@format,@waCallback(),0,#CALLBACK_FUNCTION|#WAVE_MAPPED|#WAVE_FORMAT_DIRECT)
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

outHdr\dwBufferLength = outBufferLength
outHdr\lpData = AllocateMemory(outHdr\dwBufferLength)

result = waveOutPrepareHeader_(hWo,@outHdr,SizeOf(WAVEHDR))
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

For i=0 To 100
  addTone(randomEx(400,4000),randomEx(80,500))
Next
FirstElement(tone())
playTone(@outHdr,500,tone()\frequency,tone()\duration)

OpenWindow(0,0,0,180,50,"Sound demo",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

result = waveOutReset_(hWo) ;stop playback
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

result = waveOutClose_(hWo)
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

Rook Zimbabwe · Post by **Rook Zimbabwe** » Tue Apr 13, 2010 3:26 am

Magnificent!!!

Though the random tones sound a great deal like my 5 year old niece playing the Piano...

I suspect this is some part of the MIDI sound system. Still the way you deal with it reminds me of the ANTIC/Atari sound workshop.

I created a theramin like program on that (My Atari 800XL) using two joystick paddles back in 1984!

I am going to play with this!

netmaestro · Post by **netmaestro** » Tue Apr 13, 2010 3:40 am

Yeah, too cool. Those sounds can be tuned to mimic lots of oldskool games and from there your only limit is your imagination. Thanks for posting!

Joakim Christiansen · Post by **Joakim Christiansen** » Tue Apr 13, 2010 1:39 pm

Rook Zimbabwe wrote:Magnificent!!!

Though the random tones sound a great deal like my 5 year old niece playing the Piano...

Well, that was just to demonstrate the "tone" function I wrote and I didn't have time to write a cool song...

Rook Zimbabwe wrote:I suspect this is some part of the MIDI sound system. Still the way you deal with it reminds me of the ANTIC/Atari sound workshop.

It has actually nothing to do with MIDI.

Rook Zimbabwe wrote:I created a theramin like program on that (My Atari 800XL) using two joystick paddles back in 1984!

The Atari days were good days!

Rook Zimbabwe wrote:I am going to play with this!

I hope you do, and instead of using my tone generator make something fancy to manipulate the sound wave yourself

You'll see that you can create any sound in the world!

netmaestro wrote:your only limit is your imagination

Exactly!

I also made it so you can tune the sound quality, right now it's the best quality:

Code: Select all

format\wBitsPerSample = 16 ;signed, middle=0
format\nSamplesPerSec =  44100

But one may use "telephone quality" for extra old-school fun:

Code: Select all

format\wBitsPerSample = 8 ;unsigned, middle=127
format\nSamplesPerSec =  8000

Padraig · Post by **Padraig** » Tue Apr 13, 2010 4:17 pm

This is great stuff! Thanks for sharing!

For all those who want to hear a song instead of the random tones just replace:

Code: Select all

For i=0 To 100
  addTone(randomEx(400,4000),randomEx(80,500))
Next

with this:

Code: Select all

addTone(676,460): addTone(804,340):addTone(676,230):addTone(676,110):addTone(902,230):
addTone(676,230):addTone(602,230):addTone(676,460):addTone(1012,340):addTone(676,230):
addTone(676,110):addTone(1071,230):addTone(1012,230):addTone(804,230):addTone(676,230):
addTone(1012,230):addTone(1351,230):addTone(676,110):addTone(602,230):addTone(602,110):
addTone(506,230):addTone(758,230):addTone(676,460):addTone(676,460)

Enjoy!

Joakim Christiansen · Post by **Joakim Christiansen** » Tue Apr 13, 2010 4:54 pm

Padraig wrote:For all those who want to hear a song instead

Thanks for making the song!

Here is some old school sound generator I just made:

Code: Select all

EnableExplicit

Structure tone
  volume.l
  duration.l
  frequency.l
  toFrequency.l
  noise.l
  toNoise.l
EndStructure

Global hWo, outHdr.WAVEHDR, result
Global format.WAVEFORMATEX ;wave format info
Global outBufferLength = 1000000 ;1mb
Global NewList tone.tone()
Define i

Procedure.l randomEx(min,max)
  ProcedureReturn min+Random(max-min)
EndProcedure
Procedure.l minMax(value,min,max)
  If value > max
    ProcedureReturn max
  ElseIf value < min
    ProcedureReturn min
  Else
    ProcedureReturn value
  EndIf
EndProcedure
Procedure.s waveOutError(result)
  Protected error$ = Space(1000)
  waveOutGetErrorText_(result,@error$,1000)
  ProcedureReturn error$
EndProcedure
Procedure addTone(volume,duration,frequency,toFrequency=0,noise=0,toNoise=0)
  AddElement(tone())
  tone()\volume = volume
  tone()\duration = duration
  tone()\frequency = frequency
  tone()\toFrequency = toFrequency
  tone()\noise = noise
  tone()\toNoise = toNoise
EndProcedure
Procedure playToneEx(*outHdr.WAVEHDR,volume.d,length,frequency.d,toFrequency.d=0,noise.d=0,toNoise=0) ;volum 0-1000
  Protected sample.l, result
  Protected pos, dir, waveY.d = 0, maxValue, vol.d, centerValue
  Protected samplesPerHalfWave.d, waveIncrementValue.d, lastNoise, frequencyIncrementValue.d
  Protected noiseIncrementValue.d, doNoise = noise+toNoise
  
  length = (format\nSamplesPerSec / 1000*length) * format\wBitsPerSample / 8
  If format\wBitsPerSample = 8
    maxValue = 255
  ElseIf format\wBitsPerSample = 16
    maxValue = 65535
  EndIf
  centerValue = (maxValue/2)+1
  vol = volume/1000 * centerValue
  
  samplesPerHalfWave = format\nSamplesPerSec / frequency
  waveIncrementValue = vol / samplesPerHalfWave
  
  If toFrequency
    frequencyIncrementValue = (toFrequency - frequency) / length*format\wBitsPerSample/8
  EndIf
  If toNoise
    noiseIncrementValue = (toNoise - noise) / length*format\wBitsPerSample/8
  EndIf

  
  If length <= outBufferLength
    For pos=0 To length
      If toFrequency
        frequency + frequencyIncrementValue
        samplesPerHalfWave = format\nSamplesPerSec / frequency
        waveIncrementValue = vol / samplesPerHalfWave
      EndIf
      If toNoise
        noise + noiseIncrementValue
        ;Debug noise
      EndIf
      If dir = 1
        If waveY < vol
          waveY + waveIncrementValue
          If waveY >= vol
            dir = 0
          EndIf
        EndIf
      Else
        If waveY > -vol
          waveY - waveIncrementValue
          If waveY <= -vol
            dir = 1
          EndIf
        EndIf
      EndIf
      
      If doNoise;Round(noise,#PB_Round_Down)
        If lastNoise >= noise; Random(noise) = 0
          waveY = Random(centerValue)
          lastNoise = 0
        Else
          lastNoise+1
        EndIf
      EndIf
      
      
      If format\wBitsPerSample = 8
        sample = minMax(centerValue + waveY,0,maxValue) 
        PokeA(*outHdr\lpData+pos,sample)
      ElseIf format\wBitsPerSample = 16
        sample = waveY
        PokeW(*outHdr\lpData+pos,sample)
        pos+1
      EndIf
    Next
    *outHdr\dwBufferLength = length ;tell how much we wrote
    
    ;send to output buffer
    result = waveOutWrite_(hWo,@OutHdr,SizeOf(WAVEHDR))
    If result <> #MMSYSERR_NOERROR
      Debug waveOutError(result)
    EndIf
  Else
    Debug "error, length too big"
    Debug length
    Debug  *outHdr\dwBufferLength
  EndIf
EndProcedure
Procedure listOutDevices() ;run to enumerate devices if needed
  Protected cap.WAVEOUTCAPS, devices, deviceId
  devices = waveOutGetNumDevs_()
  If devices
    For deviceId=#WAVE_MAPPER To devices-1
      If waveOutGetDevCaps_(deviceId,@cap,SizeOf(WAVEOUTCAPS)) = #MMSYSERR_NOERROR
        Debug deviceId
        Debug PeekS(@cap\szPname) ;max 32 btw
      EndIf
    Next
  EndIf
EndProcedure
Procedure waCallback(hWi.l, uMsg.l, dwInstance.l, dwParam1.l, dwParam2.l)
  Protected *outHdr.WAVEHDR, byte.a, pos, sampleSize=1, x
  Select uMsg
    Case #WOM_OPEN
      Debug "open"
    Case #WOM_CLOSE
      Debug "close"
    Case #WOM_DONE
      ;Debug "done"
      *outHdr.WAVEHDR = dwParam1
      If NextElement(tone())
        ;Delay(200)
        playToneEx(@outHdr,tone()\volume,tone()\duration,tone()\frequency,tone()\toFrequency,tone()\noise,tone()\toNoise)
      Else
        Debug "done playing"
      EndIf
  EndSelect
EndProcedure

format\wFormatTag = #WAVE_FORMAT_PCM
format\nChannels = 1 ;mono
format\wBitsPerSample = 16 ;8/16 
format\nSamplesPerSec =  44100 ;8000 Hz, 11025 Hz, 22050 Hz, and 44100 Hz
format\nBlockAlign = (format\nChannels * format\wBitsPerSample) / 8 ;equal to the product of nChannels and wBitsPerSample divided by 8 (bits per byte).
format\nAvgBytesPerSec = format\nSamplesPerSec * format\nBlockAlign ;equal to the product of nSamplesPerSec and nBlockAlign

result = waveOutOpen_(@hWo,#WAVE_MAPPER+1,@format,@waCallback(),0,#CALLBACK_FUNCTION|#WAVE_MAPPED|#WAVE_FORMAT_DIRECT)
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

outHdr\dwBufferLength = outBufferLength
outHdr\lpData = AllocateMemory(outHdr\dwBufferLength)

result = waveOutPrepareHeader_(hWo,@outHdr,SizeOf(WAVEHDR))
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

Define frequency, toFrequency, noise, toNoise, duration
For i=0 To 200
  If Random(1)=1
    duration = randomEx(100,1000)
    Repeat
      frequency = randomEx(100,4000)
      toFrequency = randomEx(100,4000)
    Until Abs(frequency-toFrequency) > 100
  Else
    duration = randomEx(100,500)
    frequency = randomEx(100,4000)
    toFrequency=0
  EndIf
  If Random(1)=1
    Repeat
      noise = randomEx(1,200)
      toNoise = randomEx(1,200)
    Until Abs(noise-toNoise) > 50
  Else
    noise=0
    toNoise=0
  EndIf
  addTone(900,duration,frequency,toFrequency,noise,toNoise)
  If (toFrequency Or toNoise) And Random(1)=1 ;reverse it?
    addTone(900,duration,toFrequency,frequency,toNoise,noise)
  EndIf
Next
FirstElement(tone())
playToneEx(@outHdr,900,1,0)

OpenWindow(0,0,0,180,50,"Sound demo",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
ClearList(tone())

result = waveOutReset_(hWo) ;stop playback
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

result = waveOutClose_(hWo)
If result <> #MMSYSERR_NOERROR
  Debug waveOutError(result)
EndIf

SFSxOI · Post by **SFSxOI** » Wed Apr 14, 2010 2:15 pm

Very nice, thank you. Exactly what I needed for a little sound added to a project i'm working on with the visually impaired in mind. I was just sitting here thinking about how to add some sound cues, then looked at the forum and here it was. The kids will love it in computer camp this summer.

kenmo · Post by **kenmo** » Fri Apr 16, 2010 11:12 pm

Joakim Christiansen wrote:Would anyone want to have an old-school sound effects contest (recreating Commodore/Atari sounds, etc) ?

I actually have playing around with sound generation over the past year, though I didn't get too far...

Your version sounds better, seems more user-friendly, and probably has more possibilities! But mine is cross-platform I think!

I made up my own system of frequency and volume keyframes, but it only allows one tone per sound... Code:

Code: Select all

; +--------+---------------+
; | WavLib | kenmo         |
; +--------+---------------+
; |  4.20.2009 - Creation

; Channel Constants
#WV_Mono     = %00000001
#WV_Stereo   = %00000010
#WV_Channels = %00000011
#WV_Left     =  0
#WV_Right    =  1

; Bit Depth Constants
#WV_8Bit     = %00000100
#WV_16Bit    = %00001000
#WV_BitDepth = %00001100

; 16-bit Range
#WV_Max16 =  32767
#WV_Mid16 =  0
#WV_Min16 = -32768

; 8-bit Range
#WV_Max8 = 255
#WV_Mid8 = 128
#WV_Min8 = 0

; Wave Types
#WV_Sine   = 0
#WV_Square = 1

; Sample Rate Constants
#WV_22050      = %00010000
#WV_44100      = %00100000
#WV_48000      = %01000000
#WV_OtherRate  = %10000000
#WV_SampleRate = %11110000

; Other Constants
#WV_2Pi = #PI * 2.0

; WAVE Structure
Structure WAVE
	Channels.b
	SampleRate.i
	BytesPerSecond.i
	BytesPerSample.b
	BitsPerSample.b
	Samples.i
	RawLength.i
	Raw.i
EndStructure

; WAVE Keyframe Structure
Structure WaveKeyFrame
  t.f
  v.f
EndStructure

EnableExplicit

Global __LastWavLibError.s = "No error."

Macro LastWaveError()
	__LastWavLibError
EndMacro

Macro SetLWE(Error)
	__LastWavLibError = Error
EndMacro

Procedure.i TimeWave(Seconds.f, Flags.i = #Null, SampleRate.i = 0)
	Protected *W.WAVE = #Null
	
	If Seconds > 0.0
		*W = AllocateMemory(SizeOf(WAVE))
		
		If *W
			Select (Flags & #WV_Channels)
				Case #WV_Mono, #Null : *W\Channels = 1
				Case #WV_Stereo      : *W\Channels = 2
				Default              : FreeMemory(*W) : *W = #Null : SetLWE("Number of channels is invalid.")
			EndSelect
		Else
			SetLWE("Wave memory could not be allocated.")
		EndIf
		
		If *W
			Select (Flags & #WV_BitDepth)
				Case #WV_16Bit, #Null : *W\BitsPerSample = 16
				Case #WV_8Bit         : *W\BitsPerSample = 8
				Default               : FreeMemory(*W) : *W = #Null : SetLWE("Bit depth is invalid.")
			EndSelect
		EndIf
		
		If *W
			Select (Flags & #WV_SampleRate)
				Case #WV_44100, #Null : *W\SampleRate = 44100
				Case #WV_22050        : *W\SampleRate = 22050
				Case #WV_48000        : *W\SampleRate = 48000
				Case #WV_OtherRate
					If SampleRate > 0
						*W\SampleRate = SampleRate
					Else
						FreeMemory(*W) : *W = #Null : SetLWE("Sample Rate must be positive, in samples per second (Hz).")
					EndIf
				Default
					FreeMemory(*W) : *W = #Null : SetLWE("Sample Rate is invalid.")
			EndSelect
		EndIf
		
		If *W
			*W\BytesPerSample = *W\Channels * *W\BitsPerSample / 8
			*W\BytesPerSecond = *W\BytesPerSample * *W\SampleRate
			*W\Samples = *W\SampleRate * Seconds
			If *W\Samples > 0
				*W\RawLength = *W\Samples * *W\BytesPerSample
				*W\Raw = AllocateMemory(*W\RawLength)
				If *W\Raw
					; Success
				Else
					FreeMemory(*W) : *W = #Null : SetLWE("WAV buffer could not be allocated.")
				EndIf
			Else
				SetLWE("Sample Rate is invalid.")
			EndIf
		EndIf
		
	Else
		SetLWE("Wave length must be positive, in seconds.")
	EndIf
	
	ProcedureReturn *W
EndProcedure

Procedure.i LoadWave(File.s)
	Protected *W.WAVE = #Null
	Protected FN.i, x.i

	If File
		FN = ReadFile(#PB_Any, File)
		If FN
		
			; RIFF Chunk
			If ReadLong(FN) = 'FFIR'
				ReadLong(FN) ; Total Length Of Package To Follow
				If ReadLong(FN) = 'EVAW'
					
					; FORMAT Chunk
					If ReadLong(FN) = ' tmf'
						If (ReadLong(FN) = $10) And (ReadWord(FN) = $01)
							*W = AllocateMemory(SizeOf(WAVE))
							*W\Channels = ReadWord(FN)
							*W\SampleRate = ReadLong(FN)
							*W\BytesPerSecond = ReadLong(FN)
							*W\BytesPerSample = ReadWord(FN)
							*W\BitsPerSample = ReadWord(FN)
							
							; DATA Chunk
							If ReadLong(FN) = 'atad'
								x = ReadLong(FN)
								If x > 0
									If (Lof(FN) - Loc(FN)) >= x
										*W\RawLength = x
										*W\Raw = AllocateMemory(x)
										If *W\Raw
											If ReadData(FN, *W\Raw, x)
												; Success
											Else
												SetLWE("WAV data could not be read.")
												FreeMemory(*W\Raw) : *W\Raw = #Null
												FreeMemory(*W) : *W = #Null
											EndIf
										Else
											SetLWE("WAV buffer could not be allocated.")
											FreeMemory(*W) : *W = #Null
										EndIf
									Else
										SetLWE("WAV data is incomplete.")
										FreeMemory(*W) : *W = #Null
									EndIf
								Else
									SetLWE("WAV data length is invalid.")
									FreeMemory(*W) : *W = #Null
								EndIf
							Else
								SetLWE("Not a valid WAV file." + #LF$ + "No data header.")
								FreeMemory(*W) : *W = #Null
							EndIf
						Else
							SetLWE("Not a valid WAV file." + #LF$ + "Format size is invalid.")
						EndIf
					Else
						SetLWE("Not a valid WAV file." + #LF$ + "No fmt_ header.")
					EndIf
				Else
					SetLWE("Not a valid WAV file." + #LF$ + "No WAVE header.")
				EndIf
			Else
				SetLWE("Not a valid WAV file." + #LF$ + "No RIFF header.")
			EndIf

			CloseFile(FN)
		Else
			SetLWE("File could not be opened.")
		EndIf
	Else
    SetLWE("No file specified.")
	EndIf
	
	If *W
		If (*W\Channels = $01) Or (*W\Channels = $02)
			If (*W\BytesPerSample > 0) And (*W\BytesPerSample < 5)
				If (*W\BitsPerSample = 8) Or (*W\BitsPerSample = 16)
					If (*W\RawLength % *W\BytesPerSample) = 0
						*W\Samples = *W\RawLength / *W\BytesPerSample
					Else
						SetLWE("WAV data length is incorrect.")
						FreeMemory(*W\Raw) : FreeMemory(*W) : *W = #Null
					EndIf
				Else
					SetLWE("Bits per sample is invalid.")
					FreeMemory(*W\Raw) : FreeMemory(*W) : *W = #Null
				EndIf
			Else
				SetLWE("Bytes per sample is invalid.")
				FreeMemory(*W\Raw) : FreeMemory(*W) : *W = #Null
			EndIf
		Else
			SetLWE("Number of channels is invalid.")
			FreeMemory(*W\Raw) : FreeMemory(*W) : *W = #Null
		EndIf
	EndIf

	ProcedureReturn *W
EndProcedure

Procedure.l SaveWave(*Wave.WAVE, File.s)
	Protected Result.l = #False, FN.l
	
	If (*Wave And *Wave\Raw)
		FN = CreateFile(#PB_Any, File)
		If FN
			
			; RIFF Chunk
			WriteLong(FN, 'FFIR')
			WriteLong(FN, *Wave\RawLength + 36)
			WriteLong(FN, 'EVAW')
			
			; FORMAT Chunk
			WriteLong(FN, ' tmf')
			WriteLong(FN, $0010)
			WriteWord(FN, $01)
			WriteWord(FN, *Wave\Channels)
			WriteLong(FN, *Wave\SampleRate)
			WriteLong(FN, *Wave\BytesPerSecond)
			WriteWord(FN, *Wave\BytesPerSample)
			WriteWord(FN, *Wave\BitsPerSample)
			
			; DATA Chunk
			WriteLong(FN, 'atad')
			WriteLong(FN, *Wave\RawLength)
			WriteData(FN, *Wave\Raw, *Wave\RawLength)
			
			CloseFile(FN)
			Result = #True
		Else
			SetLWE("File could not be created.")
		EndIf
	Else
		SetLWE("Source Wave is invalid.")
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.i CatchWave(*Wave.WAVE, Sound.i)
  Protected Result.i, *P.i
  
  Result = #Null
  If *Wave
    *P = AllocateMemory(44 + *Wave\Samples * *Wave\BytesPerSample)
    If *P
      ; RIFF Chunk
      PokeL(*P + 0, 'FFIR')
      PokeL(*P + 4, *Wave\RawLength + 36)
      PokeL(*P + 8, 'EVAW')
      
      ; FORMAT Chunk
      PokeL(*P + 12, ' tmf')
      PokeL(*P + 16, $0010)
      PokeW(*P + 20, $01)
      PokeW(*P + 22, *Wave\Channels)
      PokeL(*P + 24, *Wave\SampleRate)
      PokeL(*P + 28, *Wave\BytesPerSecond)
      PokeW(*P + 32, *Wave\BytesPerSample)
      PokeW(*P + 34, *Wave\BitsPerSample)
      
      ; DATA Chunk
      PokeL(*P + 36, 'atad')
      PokeL(*P + 40, *Wave\RawLength)
      CopyMemory(*Wave\Raw, *P + 44, *Wave\RawLength)
      
      Result = CatchSound(Sound, *P)
      If Not Result
        SetLWE("Could not catch Wave.")
      EndIf
      FreeMemory(*P)
    Else
      SetLWE("Could not allocate memory for CatchSound().")
    EndIf
  Else
    SetLWE("Source Wave is invalid.")
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure FreeWave(*Wave.WAVE)
	If *Wave
		If *Wave\Raw
			FreeMemory(*Wave\Raw)
		EndIf
		FreeMemory(*Wave)
	EndIf
EndProcedure

Procedure.i CopyWave(*Wave.WAVE)
	Protected *W.WAVE = #Null
	
	If *Wave And (*Wave\Raw)
		*W = AllocateMemory(SizeOf(WAVE))
		CopyMemory(*Wave, *W, SizeOf(WAVE))
		*W\Raw = AllocateMemory(*W\RawLength)
		If *W\Raw
			CopyMemory(*Wave\Raw, *W\Raw, *W\RawLength)
		Else
			SetLWE("WAV buffer could not be allocated.")
			FreeMemory(*W) : *W = #Null
		EndIf
	Else
		SetLWE("Source Wave is invalid.")
	EndIf
	
	ProcedureReturn *W
EndProcedure

Procedure.w WaveSample(*Wave.WAVE, Sample.i, Channel.l = #WV_Left)
	Protected *P.i, x.w
	
	If (*Wave) And (*Wave\Raw)
		If (Sample >= 0) And (Sample < *Wave\Samples)
			*P = *Wave\Raw + *Wave\BytesPerSample * Sample
			If (Channel = #WV_Right)
			  If (*Wave\Channels = #WV_Stereo)
				  *P = *P + *Wave\BytesPerSample >> 1
				EndIf
			EndIf
			If *Wave\BitsPerSample = 8
				x = PeekA(*P)
			Else
				x = PeekW(*P)
			EndIf
		EndIf
	Else
		x = 0
	EndIf
	
	ProcedureReturn x
EndProcedure

Procedure SetWaveSample(*Wave.WAVE, Index.i, Value.l, Channel.i = #WV_Left)
	Protected *P.i, x.w
	
	If (*Wave) And (*Wave\Raw)
		If (Index >= 0) And (Index < *Wave\Samples)
			*P = *Wave\Raw + *Wave\BytesPerSample * Index
			If (Channel = #WV_Right)
			  If (*Wave\Channels = #WV_Stereo)
				  *P = *P + *Wave\BytesPerSample >> 1
		    Else
		      *P = #Null
		    EndIf
			EndIf
			If *P
    		If *Wave\BitsPerSample = 8
    		  If Value > #WV_Max8 : Value = #WV_Max8 : EndIf
    		  If Value < #WV_Min8 : Value = #WV_Min8 : EndIf
    			PokeA(*P, Value)
    		Else
    		  If Value > #WV_Max16 : Value = #WV_Max16 : EndIf
    		  If Value < #WV_Min16 : Value = #WV_Min16 : EndIf
    			PokeW(*P, Value)
    		EndIf
			EndIf
		EndIf
	EndIf
EndProcedure

Procedure.f WaveLength(*Wave.WAVE)
  Protected Result.f
  
  Result = 0.0
  If *Wave
    Result = *Wave\Samples / *Wave\SampleRate
    If Result < 0.0 : Result = 0.0 : EndIf
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.i CatchWaveGen(*P.i)
  Protected *W.Wave
  Protected Time.f, Flags.i, SRate.i
  Protected WType.i, FreqKeys.i, VolKeys.i, PanKeys.i
  Protected FK.i, NFK.i
  Protected VK.i, NVK.i
  Protected PK.i, NPK.i
  Protected f.f, n.i, Angle.f, t.f
  Protected Freq.f, Vol.f, Pan.f
  Protected Swing.i, Middle.i, Sample.l
  
  *W = #Null
  If *P
    If PeekL(*P + 0) = 'WVGN'
      Time = PeekF(*P + 4)
      Flags = PeekL(*P + 8)
      SRate = PeekL(*P + 12)
      *W = TimeWave(Time, Flags, SRate)
      If *W
        WType = PeekW(*P + 16)
        *P = *P + 18
        
        Select *W\BitsPerSample
          Case 8  : Middle = #WV_Mid8  : Swing = (#WV_Max8  - #WV_Min8)  / 2
          Default : Middle = #WV_Mid16 : Swing = (#WV_Max16 - #WV_Min16) / 2
        EndSelect
        
        ; Frequency
        f = Abs(PeekF(*P)) : *P + 4
        FreqKeys = PeekW(*P) : *P + 2
        Dim Freq.WaveKeyFrame(FreqKeys)
        Freq(0)\t = 0.0 : Freq(0)\v = f
        For n = 1 To FreqKeys
          Freq(n)\t = Abs(PeekF(*P)) : *P + 4
          Freq(n)\v = Abs(PeekF(*P)) : *P + 4
        Next n
        
        ; Volume
        f = Abs(PeekF(*P)) : *P + 4
        VolKeys = PeekW(*P) : *P + 2
        Dim Vol.WaveKeyFrame(VolKeys)
        Vol(0)\t = 0.0 : Vol(0)\v = f
        For n = 1 To VolKeys
          Vol(n)\t = Abs(PeekF(*P)) : *P + 4
          Vol(n)\v = Abs(PeekF(*P)) : *P + 4
        Next n
        
        ; Pan
        If *W\Channels > 1
        Else
          Dim Pan.WaveKeyFrame(0)
          Pan(0)\t = 0.0 : Pan(0)\v = 0.0
        EndIf
        
        ; Set up Wave
        FK = 0 : If FreqKeys > 0 : NFK = 1 : Else : NFK = -1 : EndIf
        VK = 0 : If VolKeys  > 0 : NVK = 1 : Else : NVK = -1 : EndIf
        PK = 0 : If PanKeys  > 0 : NPK = 1 : Else : NPK = -1 : EndIf
        Angle = 0.0 : Pan = 0.0
        
        ; Generate Wave
        For n = 0 To *W\Samples - 1
          t = 1.0 * n / *W\Samples
          
          ; Frequency
          WVFreqCont:
          If NFK > 0
            f = (t - Freq(FK)\t) / (Freq(NFK)\t - Freq(FK)\t)
            If f < 0.0
              Freq = Freq(FK)\v : NFK = -1
            ElseIf f > 1.0
              If NFK < FreqKeys
                FK = NFK : NFK + 1
                While (Freq(FK)\t = Freq(NFK)\t)
                  FK = NFK : NFK + 1
                  If NFK > FreqKeys : NFK = -1 : Break : EndIf
                Wend
                Goto WVFreqCont
              Else
                NFK = -1
              EndIf
            Else
              f = f*f
              Freq = Freq(FK)\v + f * (Freq(NFK)\v - Freq(FK)\v)
            EndIf
          Else
            Freq = Freq(FK)\v
          EndIf
          
          ; Volume
          WVVolCont:
          If NVK > 0
            f = (t - Vol(VK)\t) / (Vol(NVK)\t - Vol(VK)\t)
            If f < 0.0
              Vol = Vol(VK)\v : NVK = -1
            ElseIf f > 1.0
              If NVK < VolKeys
                VK = NVK : NVK + 1
                While (Vol(VK)\t = Vol(NVK)\t)
                  VK = NVK : NVK + 1
                  If NVK > VolKeys : NVK = -1 : Break : EndIf
                Wend
                Goto WVVolCont
              Else
                NVK = -1
              EndIf
            Else
              Vol = Vol(VK)\v + f * (Vol(NVK)\v - Vol(VK)\v)
            EndIf
          Else
            Vol = Vol(VK)\v
          EndIf
          
          ; Pan
          If *W\Channels > 1
            Pan = 0.0
          EndIf
          
          ; Wave Shape
          Angle = Angle + (Freq * #WV_2Pi / *W\SampleRate)
          While Angle > #WV_2Pi : Angle - #WV_2Pi : Wend
          Select WType
            Case #WV_Square
              If Angle <= #PI
                f = 1.0
              Else
                f = -1.0
              EndIf
            Default
              f = Sin(Angle)
          EndSelect
          
          ; Write Sample
          Sample = Middle + Swing * (f * Vol)
          If *W\Channels = 1
            SetWaveSample(*W, n, Sample)
          Else
            If Pan >= 0.0
              SetWaveSample(*W, n, Sample * (1.0 - Pan), #WV_Left)
              SetWaveSample(*W, n, Sample, #WV_Right)
            Else
              SetWaveSample(*W, n, Sample, #WV_Left)
              SetWaveSample(*W, n, Sample * (1.0 + Pan), #WV_Right)
            EndIf
          EndIf
        Next n
        
      EndIf
    Else
      SetLWE("WaveGen is invalid.")
    EndIf
  Else
    SetLWE("WaveGen pointer is invalid.")
  EndIf
  
  ProcedureReturn *W
EndProcedure

Procedure.i CatchSoundGen(*P.i, Sound.i)
  Protected Result.i, *W.Wave
  
  Result = #Null
  If *P
    *W = CatchWaveGen(*P)
    If *W
      Result = CatchWave(*W, Sound)
      FreeWave(*W)
    EndIf
  EndIf
  
  ProcedureReturn Result
EndProcedure

; ================================  EXAMPLE PROGRAM  ================================

DisableExplicit

DataSection
  ; Stored WaveGen
  Jump:
  Data.l 'WVGN' ; Header
  Data.f 0.15    ; Length (seconds)
  Data.i #WV_Mono|#WV_16Bit ; Flags (channels / bit-rate)
  Data.i 44100  ; Sample Rate
  Data.w #WV_Square ; Wave Shape
  
  ; Frequency
  Data.f 440.0 ; Initial
  Data.w 1  ; Keyframes (after initial)
  Data.f 1.00, 1760.0 ; Keyframe (time, frequency)
  
  ; Volume
  Data.f 0.00 ; Initial
  Data.w 3  ; Keyframes (after initial)
  Data.f 0.01, 0.80  ; Keyframe (time, volume)
  Data.f 0.99, 0.80
  Data.f 1.00, 0.00
  
  ; Stored WaveGen
  Low:
  Data.l 'WVGN' ; Header
  Data.f 0.15    ; Length (seconds)
  Data.i #WV_Mono|#WV_16Bit ; Flags (channels / bit-rate)
  Data.i 44100  ; Sample Rate
  Data.w #WV_Square ; Wave Shape
  
  ; Frequency
  Data.f 44.0 ; Initial
  Data.w 1  ; Keyframes (after initial)
  Data.f 1.00, 33.0 ; Keyframe (time, frequency)
  
  ; Volume
  Data.f 0.00 ; Initial
  Data.w 3  ; Keyframes (after initial)
  Data.f 0.01, 0.80  ; Keyframe (time, volume)
  Data.f 0.99, 0.80
  Data.f 1.00, 0.00
  
  ; Stored WaveGen
  Rise:
  Data.l 'WVGN' ; Header
  Data.f 2.00    ; Length (seconds)
  Data.i #WV_Mono|#WV_16Bit ; Flags (channels / bit-rate)
  Data.i 44100  ; Sample Rate
  Data.w #WV_Sine ; Wave Shape
  
  ; Frequency
  Data.f 500.0 ; Initial
  Data.w 1  ; Keyframes (after initial)
  Data.f 1.00, 15000.0 ; Keyframe (time, frequency)
  
  ; Volume
  Data.f 0.00 ; Initial
  Data.w 1  ; Keyframes (after initial)
  Data.f 0.70, 0.90  ; Keyframe (time, volume)
  
EndDataSection

InitSound()

If #True
  CatchSoundGen(?Jump, 0)
  CatchSoundGen(?Low,  1)
  CatchSoundGen(?Rise, 2)
  n = 0
  Repeat
    PlaySound(n)
    n = (n + 1) % 3
    Delay(750)
  Until GetAsyncKeyState_(#VK_ESCAPE)
  FreeSound(0)
  FreeSound(1)
  FreeSound(2)
  End
EndIf

EDIT:
Just realized how much longer my code is too!

Joakim Christiansen · Post by **Joakim Christiansen** » Sat Apr 17, 2010 1:03 am

Joakim Christiansen wrote:Would anyone want to have an old-school sound effects contest (recreating Commodore/Atari sounds, etc) ?

kenmo wrote:I made up my own system of frequency and volume keyframes, but it only allows one tone per sound...

Nice kenmo!
It is just good to have different solutions, and cross-platform support is very nice!
Actually I now realized how easy it should be for me to make mine cross-platform too, so thank you.

EDIT: My first post is now updated with cross-platform code.

luis · Post by **luis** » Sat Apr 17, 2010 7:51 pm

Very nice !

I love real-time generated stuff

WilliamL · Post by **WilliamL** » Sat Apr 17, 2010 9:15 pm

@Joakim Christiansen

Played fine on my Mac. I un-commented the structure and replaced #WAVE_FORMAT_PCM with zero.

(hi Luis!)

luis · Post by **luis** » Sat Apr 17, 2010 9:25 pm

(Hi WilliamL) !

WilliamL · Post by **WilliamL** » Sun Apr 18, 2010 3:36 am

Would this be correct to add to your first code to play the song?
[edited code]

Code: Select all

;Have fun! ;-)
Procedure addTone(f,d)
    PlaySound(catchToneEx(1000,100,d,f)):Delay(d)
EndProcedure

addTone(676,460): addTone(804,340):addTone(676,230):addTone(676,110):addTone(902,230):
addTone(676,230):addTone(602,230):addTone(676,460):addTone(1012,340):addTone(676,230):
addTone(676,110):addTone(1071,230):addTone(1012,230):addTone(804,230):addTone(676,230):
addTone(1012,230):addTone(1351,230):addTone(676,110):addTone(602,230):addTone(602,110):
addTone(506,230):addTone(758,230):addTone(676,460):addTone(676,460)

RE-A · Post by **RE-A** » Sun Apr 18, 2010 8:58 am

maybe this is something to look into
http://reglos.de/musinum/
it's 16 bit stuff but the idea sounds cool, generating music out of equations.

Joakim Christiansen · Sun Apr 18, 2010 10:10 am

WilliamL wrote:Would this be correct to add to your first code to play the song?

Code: Select all

;Have fun! ;-)
Procedure addTone(f,d)
    PlaySound(catchToneEx(1000,100,f,d)):Delay(400)
EndProcedure

addTone(676,460): addTone(804,340):addTone(676,230):addTone(676,110):addTone(902,230):
addTone(676,230):addTone(602,230):addTone(676,460):addTone(1012,340):addTone(676,230):
addTone(676,110):addTone(1071,230):addTone(1012,230):addTone(804,230):addTone(676,230):
addTone(1012,230):addTone(1351,230):addTone(676,110):addTone(602,230):addTone(602,110):
addTone(506,230):addTone(758,230):addTone(676,460):addTone(676,460)

For my new code you can do that, but please change addTone to:

Code: Select all

Procedure addTone(f,d)
    PlaySound(catchToneEx(1000,1000,d,f)):Delay(d)
EndProcedure

PureBasic Forums - English

Raw Sound Creation Demo (cross-plattform)

Raw Sound Creation Demo (cross-plattform)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation (Windows)

Re: Raw Sound Creation Demo (cross-plattform)

Re: Raw Sound Creation Demo (cross-plattform)

Re: Raw Sound Creation Demo (cross-plattform)

Re: Raw Sound Creation Demo (cross-plattform)

Re: Raw Sound Creation Demo (cross-plattform)

Re: Raw Sound Creation Demo (cross-plattform)