PureBasic

Code : Tout sélectionner

; repris et modifié de Joakim L. Christiansen


;{ procedures et structures
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
	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
CompilerEndIf

Global format.WAVEFORMATEX

Procedure SW_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 SW_AddWaveHeader(*address.i, dataSize.l, channels.w, samplesPerSec.l, blockAlign.w, bitsPerSample.w)
	; 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


;		0<= volume <= 1000
;		duration : en ms
; 	frequency : en Hz

Procedure.l SW_CreateTone(*address.i, volume.d, duration, frequency.d) ; returns needed size if address=0
	;creates a triangle wave
	Protected sample.l, result
	Protected pos, x, waveY.d, maxValue, centerValue
	Protected samplesPerHalfWave, waveIncrementValue.d, size
	Protected samplesSinceHalfWave, waveTop.d
	
	nb_step = format\nSamplesPerSec / 1000 * duration
	size = nb_step * 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
	
	pos = 0
	For x = 0 To nb_step
		waveY = waveTop * (Sin(2 * #PI * frequency * 2 * x / format\nSamplesPerSec) + Sin(2 * #PI * frequency * x / format\nSamplesPerSec) + Sin(2 * #PI * frequency / 3 * x / format\nSamplesPerSec) + Sin(2 * #PI * frequency / 4 * x / format\nSamplesPerSec) + Sin(2 * #PI * frequency / 5 * x / format\nSamplesPerSec) + Sin(2 * #PI * frequency / 6 * x / format\nSamplesPerSec)) / 7
		
		Select format\wBitsPerSample
			Case 8
				sample = centerValue + waveY
				PokeA(*address + pos, sample)
				pos + 1
				
			Case 16
				sample = waveY
				PokeW(*address + pos, sample)
				pos + 2
				
		EndSelect
	Next
	
	
EndProcedure



Procedure SW_CatchTone(volume, duration, frequency)
	Protected *memory, id, size
	
	size = SW_CreateTone(0, volume, duration, frequency) ;get size
	
	*memory = AllocateMemory(44 + size)
	
	SW_CreateTone(*memory + 44, volume, duration, frequency) ;write wave data to memory
	SW_AddWaveHeader(*memory, size, format\nChannels, format\nSamplesPerSec, format\nBlockAlign, format\wBitsPerSample)
	
	id = CatchSound(#PB_Any, *memory)
	FreeMemory(*memory)
	
	ProcedureReturn id
EndProcedure


;}

;{ initialisation

InitSound()

SW_SetWaveFormat(16, 44100)

;}



;{ n'importe quoi, mais bien fait, avec la libération des sons etc...

; ; pompe funèbre
; #theme = 400
; #theme_min = 100

; bridé
#theme = 3000
#theme_min = 100

; ; joyeuses paques
; #theme = 3000
; #theme_min = 2000


Procedure Lanceur_de_lapin_enfariner(avec_un_delay_de_x_ms.l)
	id = SW_CatchTone(500, avec_un_delay_de_x_ms, Random(#theme) + #theme_min) : PlaySound(id) : Delay(avec_un_delay_de_x_ms)
	FreeSound(id)
EndProcedure


Repeat
	long = Random(1000) + 200
	CreateThread(@Lanceur_de_lapin_enfariner(), long)
	
	Delay(Random(50) + 200)
e+1:Until e = 100


;}

End ; et enfin, la fin de cette absurdité