Create/Play Wav Files

This program demonstrate OOP and the use of Buffers, to produce wav files, stereo and mono. There is a a tone generator.  Sound statement plays in background from buffer or from file. We can load a file as a  buffer object and then we can use Sound to play it. Sound "" stop any sound.

Class AnyChunk {
	ChunkName$=Str$("ERR0")   // 4 bytes
	ChunkSize=0&
	Function RetBuffer() {
		Error "Not defined yet"
	}
}
Class wFormatWave as AnyChunk{
          CompressionCode As Integer
          NbrOfChannels As Integer
          SampleRate As Long
          BytesPerSecond As Long
          BlockAlign As Integer
          SigBitsPerSamp As Integer
	Enum WaveType {Bit16Stereo=-1, Bit16}
	Stereo as WaveType=Bit16
	Function RetBuffer() {
		Buffer Clear ExportBuf as integer*(8&+.ChunkSize)
		Return ExportBuf, 0:=.ChunkName$, 2:=.ChunkSize as long
		Return ExportBuf, 4:=.CompressionCode, 5:=.NbrOfChannels
		Return ExportBuf, 6:=.SampleRate as long, 8:=.BytesPerSecond as long
		Return ExportBuf, 10:=.BlockAlign, 11:=.SigBitsPerSamp
		=ExportBuf
	}
class:
	Module wFormatWave (.stereo) {
		.ChunkName$<=Str$("fmt ")   // 4 bytes
		.ChunkSize<=16
		.CompressionCode<=1
		.SampleRate<=44100
		.NbrOfChannels<= if(.Stereo=.Bit16->1, 2)
		.BytesPerSecond<= if(.Stereo=.Bit16->88200, 176400)
		.BlockAlign<=if(.Stereo=.Bit16->2, 4)
		.SigBitsPerSamp<=16
	}
}
Class wChunk as AnyChunk {
	Buffer Sample as integer*10
	Module ChunkSizeLet (snd as buffer) {
		.ChunkName$<=Str$("data")   // 4 bytes
		 .Sample<=snd
		.ChunkSize<=len(snd)
	}
	Sb=lambda  (c, m, db=0)->{' hz, values
		def gain(db)=10**(db/20)
		// def db(in, out)=20*log(out/in)
		r=0x7fff*gain(db):N=44100:Z=360/N
		i=0:k=0:m*=N
		if m<=0 Then  Error "Positive Duration"
		Buffer clear snd as integer*ceil(m)
		While k<m:Return snd, k:=lowword(uint(sin(c*i )*r)):i+=Z:k++:end while
		=snd
	}
	Function RetBuffer {
		Buffer Clear ExportBuf as integer*(8&+.ChunkSize)/2
		Return ExportBuf, 0:=.ChunkName$, 2:=.ChunkSize as long
		Return ExportBuf, 4:=Eval$(.Sample)
		=ExportBuf
	}
class:
	Module wChunk {
		if not empty then call .ChunkSizeLet
	}
}
Class wChunkMono as wChunk {
class:
	Module wChunkMono {
		if not empty then call .ChunkSizeLet
	}
}
Class wChunkStereo as wChunk {
	Enum ChannelNo {LeftChannel=0, RightChannel}
	Module SamplesMonoInput (SampleL as Buffer, SampleR as Buffer) {
		Max=Min.Data(Len(SampleL), Len(SampleR)) div 2
		Buffer Clear .Sample as integer*Max*2
		w=0
		For i=0 to Max-1
			Return .Sample, w:=Eval(SampleL, i),w+1:=Eval(SampleR, i) : w+=2
		next
		.ChunkSizeLet .Sample
	}
	Function ExportMono(Channel as ChannelNo) {
		Max=.ChunkSize div 2
		Buffer ExportBuf as Integer*(Max div 2)
		w=Channel*2
		For i=0 to Max-1
			Return ExportBuf, i:=Eval(.Sample, w): w+=2
		next
		=ExportBuf
	}	
class:
	Module wChunkStereo {
		if not empty then call .ChunkSizeLet
	}
}

CLass WaveFactory {
Private:
	ChunkID$=str$("RIFF")
	RiffType$=Str$("WAVE")
	Dim Chunk()
	M=0, fmtAt=-1
Public:
	Property WavFileLen {Value}=0
	Function AddChunk (chunk as AnyChunk){
		if chunk.ChunkName$=Str$("fmt ") then
			if .fmtAt<>-1 then
				.Chunk(.fmtAt)=chunk
				Exit
			else
				.fmtAt<=.M
			end if
		end if
		=.M
		.M++
		Dim .Chunk(.M)
		.Chunk(.M-1)=chunk
		acc=12
		for i=0 to .M-1
			ch->(.chunk(i))
			acc+=ch=>ChunkSize+8&
		next
		.[WavFileLen]<=acc
	}
	Function IsStereo {
		f=.Format()
		=f.stereo=f.Bit16Stereo
	}
	Function ReadChunk(q) {
		if q<0& or q>=.M then Error "Chunck Number Not Exist"
		=.Chunk(q)
	}
	Function Count() {
		=.M
	}
	Function Format {
		if .fmtAt=-1 Then Error "No format chunck import yet"
		=.Chunk(.fmtAt)
	}
	Function ExportWavBuffer() {

		Long datapos
		Def Decimal where
		f=.format()
		align=f.BlockAlign
		if align=0 then error "Define block align please"
		if align=2 then
			Buffer ExportWav as integer*.[WavFileLen] div 2
			Return ExportWav, 0:=.ChunkID$, 2:=.[WavFileLen] as long, 4:=.RiffType$
			Return ExportWav, 6:=Eval$(f.RetBuffer())
		else.if align=4 Then
			Buffer ExportWav as Long*.[WavFileLen] div 4
			Return ExportWav, 0:=.ChunkID$, 1:=.[WavFileLen], 2:=.RiffType$
			Return ExportWav, 3:=Eval$(f.RetBuffer())
		else
			error "Align 2 or 4"
		end if
		where=Ceil((20+f.ChunkSize) /align)
		for i=0 to .M-1
			if i<>.fmtAt Then
				ch=.chunk(i)
				bbb=ch.RetBuffer()
				Return ExportWav, where:=eval$(ch.RetBuffer())
				where+=ceil(ch.ChunkSize/align)
			end if
		Next
		=ExportWav
	}
Class:
	Module WaveFactory(type$="WAVE") {
		type$=Left$(type$+"    ", 4)
		.RiffType$<=str$(ucase$(type$))
	}	
}
Const Bit16Stereo=-1, Bit16=0
fileWave=WaveFactory()
w=fileWave.AddChunk(wFormatWave(Bit16Stereo))
mono->wChunkMono()
c1000 = mono=>sb(1000, 5, -3)
c440 = mono=>sb(440, 5, -3)
stereo1=wChunkStereo()
stereo1.SamplesMonoInput c1000, c440
w=fileWave.AddChunk(stereo1)
sound1=fileWave.ExportWavBuffer()
open "sinStereo.wav" for output as #f
	put #f, sound1
close #f
fileWave=WaveFactory()
w=fileWave.AddChunk(wFormatWave(Bit16))
mono=>ChunkSizeLet c440
w=fileWave.AddChunk(mono)
sound2=fileWave.ExportWavBuffer()
open "sinMono440.wav" for output as #f
	put #f, sound2
close #f
fileWave=WaveFactory()
w=fileWave.AddChunk(wFormatWave(Bit16))
mono=>ChunkSizeLet c1000
w=fileWave.AddChunk(mono)
sound3=fileWave.ExportWavBuffer()
open "sinMono1000.wav" for output as #f
	put #f, sound3
close #f
i=0
Thread {
	Print i
	i++
} as TT interval 10
Sound sound1
Wait 5000
Sound sound2
Wait 5000
Sound sound3
Wait 5000
Sound "sinStereo.wav"
Threads  Erase