CrossPlatform RetroSound with FMOD or FBSOUND

redcrab · Post by **redcrab** » Aug 17, 2007 9:19

Do you like QB sound ?
Or retro sound stuff ?
Here a quick implementation of QB "sound" with FMOD and FBSOUND

The very only extra stuff you need is the FMOD library or FBSOUND
The fmod.dll that i've used with windows is here http://csgp.suret.net/fmod.dll
(no need to have any sample file or other resources)

Comment or uncomment the #define SOUNDLIB to choose the Sound library (beginning of source code)

Code: Select all

#Define SOUNDLIB NO_SOUND
#Define SOUNDLIB FMOD
#Define SOUNDLIB FBSOUND

NO_SOUND is usefull when there is no lib available (no .DLL no .so)
but all sound command remain available (quiet of course) with the same timing : sequencer still playing, blocking mode sound will still take time...

Usefull tip when you want to release your binary code with a "no sound" version without changing your program source code

the music compo for the sequencer test is crappy... I know ... but I'm not a musician ;P

here follow the code

Enjoy and have fun !

Code: Select all

' **************************************
' RETRO SOUND BY REDCRAB 17/08/2007
' IMPLEMENTATION FOR FMOD/FBSOUND
'**************************************
' IF NO_SOUND all sound are played but silently(No lib dependency !)
'#Define SOUNDLIB NO_SOUND
'#Define SOUNDLIB FMOD
#Define SOUNDLIB FBSOUND
' ---------------------
' ----- DECLARATION

#If SOUNDLIB=FMOD
#Include once "fmod.bi"
#Define SOUNDLIBNAME "FMOD"
#EndIf

#If SOUNDLIB=FBSOUND
#Include Once "fbsound.bi"
#Define SOUNDLIBNAME "FBSOUND"
#EndIf

#If SOUNDLIB=NO_SOUND
#Define SOUNDLIBNAME "NO_SOUND"
#endif

#Ifndef PI
#Define PI 3.141592654
#EndIf
' wave form sample quantity 
#If SOUNDLIB=FBSOUND
#Define RS_SAMPLESIZE 1600
#Define RS_SAMPLEPERBUFFER 10
#EndIf

#If SOUNDLIB=FMOD
#Define RS_SAMPLESIZE 80
#Define RS_SAMPLEPERBUFFER 1
#EndIf

#If SOUNDLIB=NO_SOUND
#Define RS_SAMPLESIZE 16
#Define RS_SAMPLEPERBUFFER 1
#EndIf

' wave form catalog size
#Define RS_MAXWAVEFORM 15
#Define RS_MINWAVEFORM 0
' channel quantity
#Define RS_MAXCHANNEL 7 
#Define RS_MINCHANNEL 0 
' Note Buffer
#Define RS_MINNOTEBUFFER 0
#Define RS_MAXNOTEBUFFER 6000

Enum waveform
  SINE = 0
  SAW
  SQUARE
  SPECIAL
  NOISE = RS_MAXWAVEFORM
End Enum


' Channel Information 
Type RS_Channel
	channel As Integer
	timestart As Double
	delay As Double
	wfidx As Integer
	frequency As Integer
	volume As Integer
	isOn As integer
	Declare Constructor()
End Type

Type RS_Note
	waveform As Integer
	frequency As Integer
	volume As Integer
	delay As Double
End Type


Type RS_NoteBuffer
	_noteBuffer(RS_MINNOTEBUFFER To RS_MAXNOTEBUFFER) As RS_Note
	_noteBufferStart As Integer
	_noteBufferEnd As Integer
	Declare Sub addNote(wfidx As Integer, freq As Integer, vol As integer, delay As Double)
	Declare Function getNote() As RS_Note
	Declare Function hasNote() As Integer
	Declare Function isFull() As Integer
	Declare Constructor()
End Type

Constructor RS_channel()
#If SOUNDLIB=FMOD
   channel = FSOUND_FREE
#endif
   timestart = 0
   delay = 0
   wfidx = -1
   frequency = -1
   volume = -1
   isOn = 0
End Constructor


' main "class"
Type RetroSound
	_buff(0 To RS_SAMPLESIZE*RS_SAMPLEPERBUFFER-1) As Short
	_channel(RS_MINCHANNEL To RS_MAXCHANNEL) As RS_channel
	_noteBuffer(RS_MINCHANNEL To RS_MAXCHANNEL) As RS_NoteBuffer
#If SOUNDLIB=FBSOUND
	_hSoundTable(RS_MINCHANNEL To RS_MAXCHANNEL,RS_MINWAVEFORM To RS_MAXWAVEFORM) As Integer
#EndIf
	_
#If SOUNDLIB=FMOD	
	_waveForm(RS_MINWAVEFORM To RS_MAXWAVEFORM) As FSOUND_SAMPLE ptr
#endif
	_defaultChannel As Integer
	_defaultWaveForm  As integer
	_defaultVolume As integer
	_note(0 To 127) As integer
	' Intialize the Engine
	Declare Constructor()
	' close the engine
	Declare Destructor()
	' set a waveform into the catalog
	' wfi is the catalog index betwwen RS_MINWAVEFORM and RS_MAXWAVEFORM
	'wf : can be "SINE" "SAW" "SQUARE" "NOISE" or "0123456789ABCDEF" 16 hexadecimal value to define the 16 sample value of the wave form
	Declare Sub setWaveForm(wfi As Integer,ByRef wf As String)
	' heart of the retrosound system
	' channel : output channel between RS_MINCHANNEL and RS_MAXCHANNEL
	' wf : index inside the waveform catalog
	' freq : frequency (30 to 20000)
	' volume : 0 silence, 255 full volume
	' delay : delay in millisecond , 0= never stop, -1 = don't touch current delay (if change volume,frequency or other on the channel) 
	Declare Sub keyOnOff(channel As Integer, wf As Integer, freq As Integer, volume As Integer,  delay As double)
	' same as keyOnOff but delay = 0
	Declare Sub keyOn(channel As Integer,wf As Integer,freq As Integer,volume As Integer)
	' stop playing on channel 
	Declare Sub keyOff(channel As Integer)
	' set default channel to use when use QB sound instruction
	Declare Sub setDefault(channel As Integer, wfidx As Integer, volume As Integer) 
	' play on default channel, at frequency during "delay" millisecond, it's a blocking instruction (wait until end of delay)
	Declare Sub sound(freq As integer, delay As Double) 
	' same as above but can can choice if the call is blocking(_wait=1) or non blocking (_wait=0) or (wait=2) buffered
	Declare Sub sound(freq As integer, delay As Double, _wait As integer) 
	' method that manage the engine, call it in the game loop, or other long loop... otherwise sound delay do not works
	Declare Sub addNote(wfidx As Integer, freq As Integer, vol As integer, delay As Double)
	Declare Sub tick()
End Type

Enum seq_status
	SS_STOP = 0
	SS_PLAY
	SS_PAUSE
	SS_END
End Enum
	ReDim Shared seq(0) As String

Type SequencerCTX
	startindex As integer
	firstchannel As Integer	
	index As Integer
	repeat_addr(0 To 100) As Integer
	repeat_count(0 To 100) As Integer
	repeat_idx As Integer
	sub_stack(0 To 100) As Integer 
	sub_idx As integer
	status As Integer
	Declare Constructor()
	Declare Sub Play()
	Declare Sub Stop()
	Declare Sub Pause()
	Declare Sub Resume()
End Type


Type Sequencer
	ctx(RS_MINCHANNEL To RS_MAXCHANNEL) As SequencerCTX
	tempo As Double
	slicetimer As Double
	rs As RetroSound ptr 
	sub_addr(0 To 100) As Integer
	Declare Constructor()
	Declare Sub slice(cidx As integer)
	Declare Sub tick()
	Declare Sub load(ByRef _rs As RetroSound,seq() As String)
	Declare Sub Play()
	Declare Sub Stop()
	Declare Sub Pause()
	Declare Sub Resume()
		
End Type

' ---------------------
' ----- IMPLEMENTATION


Sub RS_NoteBuffer.addNote(wfidx As Integer, freq As Integer, vol As integer, delay As Double)
	If Not isFull() then
		_noteBuffer(_noteBufferEnd).waveform = wfidx
		_noteBuffer(_noteBufferEnd).frequency = freq
		_noteBuffer(_noteBufferEnd).volume = vol
		_noteBuffer(_noteBufferEnd).delay = delay
		_noteBufferEnd +=1
		If _noteBufferEnd > RS_MAXNOTEBUFFER Then
			_noteBufferEnd = RS_MINNOTEBUFFER
		EndIf
	End If
End Sub

function RS_NoteBuffer.isFull() As integer
	If _noteBufferStart-1 = _noteBufferEnd Or _
	(_noteBufferStart = RS_MINNOTEBUFFER And _noteBufferEnd = RS_MAXNOTEBUFFER) Then
	  Return -1
	End If
	Return 0
End function

Function RS_NoteBuffer.getNote() As RS_Note
	Dim i as integer
	If hasNote() Then
	  i = _noteBufferStart
	  _noteBufferStart+=1
	  If _noteBufferStart > RS_MAXNOTEBUFFER Then
	  	 _noteBufferStart = RS_MINNOTEBUFFER
	  EndIf
	  Return _noteBuffer(i)
	EndIf
	Return _noteBuffer(_noteBufferStart)
End Function
Function RS_NoteBuffer.hasNote() As Integer
	If _noteBufferStart = _noteBufferEnd Then Return 0
	Return -1
End Function
Constructor RS_NoteBuffer()
  _noteBufferStart = RS_MINNOTEBUFFER
  _noteBufferEnd = _noteBufferStart
End Constructor




Constructor SequencerCTX()
	index = 0
	startindex = 0
	status = SS_STOP
	firstchannel = 0
	repeat_idx = -1
	sub_idx = -1
End Constructor

Sub SequencerCTX.Play()
	If status = SS_STOP Or status = SS_END then
		repeat_idx = -1
		sub_idx = -1
		status = SS_PLAY
		index = startindex
	End if
End Sub

Sub SequencerCTX.Pause()
	If status = SS_PLAY then
		status = SS_PAUSE
	End If
End Sub

Sub SequencerCTX.Resume()
	If status = SS_PAUSE Then 
		status = SS_PLAY
	End If
		
End Sub


Sub SequencerCTX.Stop()
	status = SS_STOP
End Sub



Sub Sequencer.slice(cidx As integer)
	Dim sl As String
	Dim cmd As String
	Dim st As String
	Dim goback As Integer
	Dim i As Integer
	Dim c As Integer
	Dim vc As string
	Dim v As Integer
	Dim v2 As integer
	If ctx(cidx).index>UBound(seq) Then
		ctx(cidx).status = SS_END
		Exit sub
	EndIf
	Print cidx;"-";ctx(cidx).index, " ";
	Do
		
		Print seq(ctx(cidx).index);",";
		sl = seq(ctx(cidx).index)
		ctx(cidx).index += 1
		cmd = UCase(Left(sl,1))
		st = cmd
		cmd = Right(sl,Len(sl)-1)
		goback = 0 ' by default stay in loop
		Select Case st
			Case "X" ' Parallel sequencer
				st = UCase(Left(cmd,1))
				cmd = Right(cmd,Len(cmd)-1)
				Select Case st
					Case "I"
						v = Val("&H0"+Left(cmd,1))
						cmd = Right(cmd,Len(cmd)-1)
						v2 = Val(cmd)
						ctx(v).startindex = sub_addr(v2)
					Case "P"
						v = Val("&H0"+Left(cmd,1))
						ctx(v).Play()						
					Case "S"
						v = Val("&H0"+Left(cmd,1))
						ctx(v).Stop()						
				End Select
			Case "W" ' Waveform choice
				c = ctx(cidx).firstchannel
				For i= 1 To Len(cmd)-1 Step 2
					vc = Mid(cmd,i,2)
					If vc <> "__" then
						v = Int(Val("&h0"+vc))
						rs->keyOn(c,v,-1,-1)
					End If
					c+=1
				Next
			Case "V" ' Volume setting
				c = ctx(cidx).firstchannel
				For i= 1 To Len(cmd)-1 Step 2
					vc = Mid(cmd,i,2)
					If vc <> "__" then
						v = Int(Val("&h0"+vc))
						rs->keyOn(c,-1,-1,v)
					End If
					c+=1
				Next
			Case "-" ' Volume setting
				c = ctx(cidx).firstchannel
				For i= 1 To Len(cmd)-1 Step 2
					vc = Mid(cmd,i,2)
					If vc <> "__" then
						v = Int(Val("&h0"+vc))
						v = rs->_channel(c).volume - v
						If v < 0 Then v = 0
						rs->keyOn(c,-1,-1,v)
					End If
					c+=1
				Next
			Case "+" ' Volume setting
				c = ctx(cidx).firstchannel
				For i= 1 To Len(cmd)-1 Step 2
					vc = Mid(cmd,i,2)
					If vc <> "__" then
						v = Int(Val("&h0"+vc))
						v = rs->_channel(c).volume + v
						If v > 255 Then v = 255
						rs->keyOn(c,-1,-1,v)
					End If
					c+=1
				Next
			Case "N"	' Note Playing
				c = ctx(cidx).firstchannel
				For i= 1 To Len(cmd)-1 Step 2
					vc = Mid(cmd,i,2)
					If vc <> "__" then
						v = Int(Val("&h0"+vc))
						rs->keyOn(c,-1,rs->_note(v),-1)
					End If
					c+=1
				Next
				'goback = 1
			Case "@" ' beginning of repeating sequence
				ctx(cidx).repeat_idx +=1
				ctx(cidx).repeat_addr(ctx(cidx).repeat_idx)= ctx(cidx).index
				ctx(cidx).repeat_count(ctx(cidx).repeat_idx) = Int(Val(cmd))-1			
			Case "L" ' sequence looping of the last valid repeat sequence
				If ctx(cidx).repeat_idx>=0 Then
					If ctx(cidx).repeat_count(ctx(cidx).repeat_idx)<>0 Then
						ctx(cidx).repeat_count(ctx(cidx).repeat_idx)-=1
						ctx(cidx).index = ctx(cidx).repeat_addr(ctx(cidx).repeat_idx)
					Else
						If ctx(cidx).repeat_count(ctx(cidx).repeat_idx)=0 Then
							ctx(cidx).repeat_idx -=1
						EndIf
					EndIf
				EndIf
			Case "T" ' change tempo
				tempo = Int(Val(cmd))*1.0/1000.0
'			Case "#" ' Marker for the beginning a sub sequence
'				v = Int(Val(cmd))
'				sub_addr(v)= index
			Case "R" ' return for a sub sequence
				If ctx(cidx).sub_idx >=0 Then
					ctx(cidx).index = ctx(cidx).sub_stack(ctx(cidx).sub_idx)
					ctx(cidx).sub_idx-=1
				Else
					ctx(cidx).status = SS_END
					goback = 1						
				EndIf
			Case "G" ' Go to a sub sequence
				v = Int(Val(cmd))
				ctx(cidx).sub_idx+=1
				ctx(cidx).sub_stack(ctx(cidx).sub_idx) = ctx(cidx).index
				ctx(cidx).index = sub_addr(v)
			Case "_" ' end of position
				goback = 1
			Case "$" ' end of song
				ctx(cidx).status = SS_END
				goback = 1
		End Select
		If ctx(cidx).index>UBound(seq) Then
			ctx(cidx).status = SS_END
			Exit sub
		EndIf
	Loop Until goback=1
	Print ""
End Sub

Constructor Sequencer()
   Dim i As Integer
   Dim j As integer
	tempo=100.0/1000.0
	j = 0
	For i = LBound(ctx) To UBound(ctx)
		ctx(i).firstchannel = j
		j += 1 
	Next
End Constructor

Sub Sequencer.tick()
	Dim i As Integer
	If Timer - (slicetimer+tempo) >= 0 Then
		slicetimer = Timer
		For i = LBound(ctx) To UBound(ctx)
			If ctx(i).status = SS_PLAY And ctx(0).status = SS_PLAY Then
				slice(i)
			Else
				If i = 0 Then Exit for
			End If
		Next i
	End If
	rs->tick()
End Sub


Sub Sequencer.Load(ByRef _rs As RetroSound, _seq() As String)
	Dim i As Integer
	Dim cmd As String
	ReDim  seq (LBound(_seq) To UBound(_seq)) As String
	For i = LBound(seq) To UBound(seq)
		seq(i) = _seq(i)	
		cmd = seq(i)
		If Left(cmd,1)="#" Then
			cmd = Right(cmd,Len(cmd)-1)
			sub_addr(Int(Val(cmd)))=i+1
		EndIf
	Next
	ctx(0).startindex = LBound(seq)
	rs = @_rs
End Sub

Sub Sequencer.Play()
	ctx(0).Play
End Sub

Sub Sequencer.Pause()
	ctx(0).Pause()
End Sub

Sub Sequencer.Resume()
	ctx(0).Resume()
End Sub


Sub Sequencer.Stop()
	Dim i As Integer
	For i = LBound(ctx) To UBound(ctx)
		ctx(i).stop()
		rs->Keyoff(i)
	Next i
	
End Sub

Constructor RetroSound()
#If SOUNDLIB=FMOD
	dim song as FMUSIC_MODULE ptr 
	Dim sample1 As FSOUND_SAMPLE ptr
#EndIf

	Dim channel1 As Integer
	Dim  As Integer i,ii
	
#If SOUNDLIB=FMOD
	'**** INIT FMOD
   ' be sure that we use correct version
	if( FSOUND_GetVersion() < FMOD_VERSION ) then
  		' Error handler
	end if

	' FMOD init with output freq, quantity of channel
	if( FSOUND_Init(44100, RS_MAXCHANNEL-RS_MINCHANNEL+1, 0) = 0) then
  		'Error handler
	end if

	'**** INIT SAMPLE
	' Allocate a FMOD sample resource
	For i = RS_MINWAVEFORM To RS_MAXWAVEFORM-1
		_waveform(i)= FSOUND_Sample_Alloc(FSOUND_FREE,RS_SAMPLESIZE,FSOUND_NORMAL or FSOUND_LOOP_NORMAL,RS_SAMPLESIZE*440,0,128,255)
		If _waveform(i) = 0 then	
  			'Error handler
		end if
	Next i
#EndIf
#If SOUNDLIB=FBSOUND
	fbs_Init(44100,1)
#EndIf

	'**** Create NOISE sample
	Dim bb(0 To 9999) As Short
	For i = 0 To 9999
		bb(i)= Int((Rnd*1.0-0.5)*32767)
	Next

#If SOUNDLIB=FMOD
	_waveform(RS_MAXWAVEFORM)= FSOUND_Sample_Alloc(FSOUND_FREE,10000,FSOUND_NORMAL or FSOUND_LOOP_NORMAL,10000,0,128,255)
		' Transfert generated noise into FMOD sample resource
	FSOUND_Sample_Upload(_waveform(RS_MAXWAVEFORM),@bb(0),FSOUND_NORMAL)
#EndIf	

#If SOUNDLIB=FBSOUND
	Dim As integer hWave,hSound
	Dim As FBS_SAMPLE Ptr  lpSamples
	For i = RS_MINCHANNEL To RS_MAXCHANNEL
		fbs_create_Wave(10000,@hWave,@lpSamples)
		For ii = 0 To 10000-1
			lpSamples[ii] = bb(ii)
		Next
		fbs_create_Sound(hWave,@hSound)
		_hSoundTable(i,RS_MAXWAVEFORM) = hSound
		fbs_Set_SoundVolume(hSound,0)
	Next i
#endif	

	' initialize default waveform catalog
	setWaveForm(RS_MINWAVEFORM+0,"SINE") 
	setWaveForm(RS_MINWAVEFORM+1,"SAW") 
	setWaveForm(RS_MINWAVEFORM+2,"SQUARE")
	setWaveForm(RS_MINWAVEFORM+3,"0F1E2D3C4B5A6978") ' CUSTOM special
	setWaveForm(RS_MINWAVEFORM+4,"02468ACEECA86420") ' ledder Up and down
	setDefault(RS_MINCHANNEL,RS_MINWAVEFORM+2,128)
	For i = 5 To RS_MAXWAVEFORM-1
		setWaveForm(RS_MINWAVEFORM+i,"NOISE")
	Next

	' initialize note
	For i = 0 To 127
		_note(i) = Int(440.0*(2^((i-57)/12))+0.5)
		If _note(i) < 30 Then _note(i) = 30
		If _note(i) > 10000 Then _note(i) = 10000
	Next

End Constructor


Destructor RetroSound()
#If SOUNDLIB=FMOD
Dim i As Integer
	For i = RS_MINCHANNEL To RS_MAXCHANNEL
		FSOUND_StopSound(i)
	Next i
	For i = RS_MINWAVEFORM To RS_MAXWAVEFORM
	FSOUND_Sample_Free( _waveform(i) )
	Next i
	FSOUND_Close
#EndIf

#If SOUNDLIB=FBSOUND
	fbs_Exit()
#EndIf


End Destructor

Sub RetroSound.setWaveForm(wfi As Integer,ByRef wf As String)
	' Create sample (in memory , with a 16bits signed monophonic structure)
	Dim As Integer i,ii
#If SOUNDLIB=FBSOUND	
	Dim As integer hWave,hSound
	Dim As FBS_SAMPLE Ptr  lpSamples
#EndIf

	If Len(wf) >=16 Then ' custom wave
		'ii = 1
		For i = LBound(_buff) To  RS_SAMPLESIZE-1 'UBound(_buff)
			ii = Int((i*1.0/((RS_SAMPLESIZE*1.0)/(Len(wf)*1.0)))+1) 
			_buff(i) = Int((Val("&h0"+Mid(wf,ii,1))/15.0-0.5) *32767) 
			'ii = ii +1
		Next
	End if		
	If ucase(wf) = "SINE" Then
		For i = LBound(_buff) To UBound(_buff)
			_buff(i) = Int(Sin(2*PI/RS_SAMPLESIZE*i)*32767)
		Next
	End if		
	If ucase(wf) = "SAW" Then
		For i = LBound(_buff) To UBound(_buff)
			_buff(i) = (i*1.0/RS_SAMPLESIZE-0.5)*32767
		Next
	End if		
	If ucase(wf) = "SQUARE" Then
		For i = LBound(_buff) To UBound(_buff)
			_buff(i) = IIf(i<RS_SAMPLESIZE/2,32767,-32767)
		Next
	End if		
	If ucase(wf) = "NOISE" Then
		For i = LBound(_buff) To UBound(_buff)
			_buff(i) = Int((Rnd*1.0-0.5)*32767.0)
		Next
	End if		
#If SOUNDLIB=FBSOUND
	For i = RS_MINCHANNEL To RS_MAXCHANNEL
		fbs_create_Wave(RS_SAMPLESIZE*RS_SAMPLEPERBUFFER,@hWave,@lpSamples)
		For ii = 0 To RS_SAMPLESIZE*RS_SAMPLEPERBUFFER-1
			lpSamples[ii] = _buff(ii Mod RS_SAMPLESIZE)
		Next
		fbs_create_Sound(hWave,@hSound)
		_hSoundTable(i,wfi) = hSound
		fbs_Set_SoundVolume(hSound,0)
	Next i
#endif
#If SOUNDLIB=FMOD	
	' Transfert customsample into FMOD sample resource	
	FSOUND_Sample_Upload(_waveform(wfi),@_buff(0),FSOUND_NORMAL)
#endif
	
End Sub

Sub RetroSound.keyOnOff(channel As Integer,wf As Integer,freq As Integer,volume As Integer, delay As double)
	'Print "Channel:";channel,"waveform:";wf,"frequence:";freq,"volume:";volume,"delay:";delay
	If freq = 0 Then
		 KeyOff(channel)
		 Exit sub
	EndIf
	If _channel(channel).wfidx <> wf And wf >=0 Then
#If SOUNDLIB=FMOD
		_channel(channel).channel = FSOUND_PlaySound(_channel(channel).channel, _waveform(wf) )
#endif	
#If SOUNDLIB=FBSOUND
		If _channel(channel).wfidx >=RS_MINWAVEFORM then
			fbs_Set_SoundVolume(_hSoundTable(channel,_channel(channel).wfidx),0)
		End If
		fbs_Play_Sound(_hSoundTable(channel,wf),&h0fffffff)
#EndIf	
		_channel(channel).wfidx = wf
		_channel(channel).frequency = -1
		_channel(channel).volume = -1
	End If
	If _channel(channel).frequency <> freq And freq >=0 Then
#If SOUNDLIB=FMOD 
		If _channel(channel).wfidx = RS_MAXWAVEFORM Then		
			FSOUND_SetFrequency(_channel(channel).channel,freq*16)
		Else
			FSOUND_SetFrequency(_channel(channel).channel,freq*RS_SAMPLESIZE)
		EndIf
		
#EndIf
#If SOUNDLIB=FBSOUND
		If wf = -1 Then
			If _channel(channel).wfidx = RS_MAXWAVEFORM then
				fbs_Set_SoundSpeed(_hSoundTable(channel,_channel(channel).wfidx),freq/(44100.0/16.0))
			Else
				fbs_Set_SoundSpeed(_hSoundTable(channel,_channel(channel).wfidx),freq/(44100.0/RS_SAMPLESIZE))
			endif				
		Else	
			If wf = RS_MAXWAVEFORM then
				fbs_Set_SoundSpeed(_hSoundTable(channel,wf),freq/(44100.0/16.0))
			Else
				fbs_Set_SoundSpeed(_hSoundTable(channel,wf),freq/(44100.0/RS_SAMPLESIZE))
			endif				
		end If	
#EndIf
		_channel(channel).frequency = freq
	End If
	If _channel(channel).volume <> volume And volume>=0 Then
#If SOUNDLIB=FMOD
		FSOUND_SetVolume(_channel(channel).channel,volume)
#endif	
#If SOUNDLIB=FBSOUND
		If wf= -1 then
			fbs_Set_SoundVolume(_hSoundTable(channel,_channel(channel).wfidx),volume/255.0)
		Else
			fbs_Set_SoundVolume(_hSoundTable(channel,wf),volume/255.0)
		End If
		
#endif	
		_channel(channel).volume = volume
	EndIf
	If delay >=0 Then 
		_channel(channel).delay = delay/1000.0
		If delay>0 Then _channel(channel).timestart = Timer
	End if	
	_channel(channel).isOn = -1
End Sub

Sub RetroSound.keyOn(channel As Integer,wf As Integer,freq As Integer,volume As Integer)
	Dim As Double delay
	delay = 0
	keyOnOff(channel, wf, freq, volume, delay)
End Sub


Sub RetroSound.keyOff(channel As Integer)
	If _channel(channel).isOn Then
		keyOn(channel,_channel(channel).wfidx,_channel(channel).frequency,0)		
	EndIf
	_channel(channel).isOn = 0
End Sub


Sub RetroSound.setDefault(channel As Integer,wfidx As Integer,volume As integer)
	_defaultChannel = channel 
	_defaultWaveForm = wfidx
	_defaultVolume = volume
	keyOnOff(_defaultchannel,_defaultWaveForm,440,0,0)
End Sub

Sub RetroSound.sound(freq As integer, delay As Double)
	sound(freq,delay,1)
End Sub

Sub RetroSound.sound(freq As integer, delay As Double, _wait As integer )
	Dim As Integer f
	Dim As Double d
	f = freq
	If f <=0 And f >=-127 Then f = _note(-f)
	If f <0 Then f= -f
	d = delay
	If _wait = 0 Or _wait = 1 then
		keyOnOff(_defaultChannel,_channel(_defaultChannel).wfidx,f,_defaultVolume,d)
		If _wait And delay > 0 Then
			While _channel( _defaultChannel).isOn
				Sleep 1,1
				tick()
			Wend
		EndIf
	End If
	If _wait = 2 And d > 0 Then
		Do
			Sleep 1,1
			tick()
		Loop Until Not _noteBuffer(_defaultChannel).isFull()
		_noteBuffer(_defaultChannel).addNote(_channel(_defaultChannel).wfidx,f,_defaultVolume,d)
	EndIf
	
End Sub 

Sub RetroSound.tick()
	Dim As Integer i
	Dim As Double tm,delta1,delta2
	Dim noteoff As double
	For i = RS_MINCHANNEL To RS_MAXCHANNEL
		If _channel(i).delay > 0 Then
			tm = Timer
			noteoff = Int((_channel(i).delay*1000.0- Int(_channel(i).delay*1000.0+0.5))*1000.0)/1000.0
	'		Print _channel(i).delay*1000,noteoff*1000
			'noteoff = 0
			delta1 = tm-(_channel(i).timestart+_channel(i).delay-noteoff)
			delta2 = tm-(_channel(i).timestart+_channel(i).delay)
			If delta1>=0 Then
				keyOnOff(i,_channel(i).wfidx,_channel(i).frequency,0,-1)
			EndIf
			If delta2>=0 Then
				KeyOff(i)
				_channel(i).delay = 0
			EndIf
		End If
		If _channel(i).delay = 0 Then		
			If _noteBuffer(i).hasNote() Then
				Dim aNote As RS_Note
				aNote = _noteBuffer(i).getNote()
				keyOnOff(i,aNote.waveform,aNote.frequency,aNote.volume,aNote.delay)
			EndIf
		EndIf
	Next
#If SOUNDLIB=FMOD
	FSOUND_Update()
#endif
End Sub


'**********************************************************************
'***** EXAMPLE ********************************************************
'**********************************************************************


#Include Once "fbgfx.bi"

	
	' instanciate only once ! (thread singleton)
	Dim Shared rs As RetroSound
	
	Dim i As Integer
	Dim j As integer
	Dim k As String
	Dim s(0 To 300) As String => _
	{"XI240", "XI410", _
	 "W01010F0F0303", _ ' set waveform
	 "T60", "G30", _
	 "W0103", "T50", "G30", _
	 "W0000", "T30", "G30", _
	 "W0202", "T40", "G30", _  
	 "V0000", _
	 "$ End", _
	 "#40", "V0000","N7001","@0","V40","G3","G3","G3","G3","V__60","G1","G1","G2","G3","V__60","G1","G1","G2","G3","Loop","Return", _ 'drums
	 "#30",  _ ' 30
	 "XP2","G10","XS4","XP4","G10", "G21","G12","G11", _ ' 10 10 20 10
	 "Return", _
	 "#10", _   ' C C C D E D C E D D C  = > 10
	 	"@3", "V0000", "N3C40","G6", "G3", "Loop 3 times", _  ' C C C
	       	"V0000", "N3E41","G6", "G3", _  ' D
	       	"V0000", "N4043","G6", "G4", _  ' E
	       	"V0000", "N3E41","G6", "G4", _  ' D
	       	"V0000", "N3C40","G6", "G3", _  ' C
	       	"V0000", "N4043","G6", "G3", _  ' E
	 	"@2", "V0000", "N3E41","G6", "G3", "Loop twice", _ ' D D 
	       	"V0000", "N3C40","G6", "G4", _ ' C
	       	"G4", _
	 "Return", _  'End of 10
	 "#11", _   ' C C C D E D C E D D C  = > 11
	 	"@3", "V0000", "N3C40","G6", "G3", "Loop 3 times", _  ' C C C
	       	"V0000", "N3E43","G6", "G3", _  ' D
	       	"V0000", "N4043","G6", "G4", _  ' E
	       	"V0000", "N3E45","G6", "G4", _  ' D
	       	"V0000", "N3C43","G6", "G3", _  ' C
	       	"V0000", "N4043","G6", "G3", _  ' E
	 	"@2", "V0000", "N3E45","G6", "G3", "Loop twice", _ ' D D 
	       	"V0000", "N3C43","G6", "G4", _ ' C
	       	"G4", _
	 "Return", _  'End of 11
	 "#12", _   ' C C C D E D C E D D C  = > 12
	 	"@3", "V0000", "N4035","G6", "G3", "Loop 3 times", _  ' C C C
	       	"V0000", "N4337","G6", "G3", _  ' D
	       	"V0000", "N4339","G6", "G4", _  ' E
	       	"V0000", "N4537","G6", "G4", _  ' D
	       	"V0000", "N4335","G6", "G3", _  ' C
	       	"V0000", "N4339","G6", "G3", _  ' E
	 	"@2", "V0000", "N4537","G6", "G3", "Loop twice", _ ' D D 
	       	"V0000", "N4335","G6", "G4", _ ' C
	       	"G4", _
	 "Return", _  'End of 12
	 "#20",_  ' D D D D A A D C B A G  = > 20
	 	"@4", "V0000", "N3E41","G6", "G3", "Loop 4 times", _ ' D D D D
	 	"@2", "V0000", "N393C","G6", "G4", "Loop twice", _ ' A A
 	 			"V0000", "N3E41","G6", "G3", _  ' D
 	 			"V0000", "N3C40","G6", "G3", _  ' C
 	 			"V0000", "N3B3E","G6", "G3", _  ' B
 	 			"V0000", "N393C","G6", "G3", _  ' A
 	 			"V0000", "N3743","G6", "G4", _  ' G
 	 			"G4",_
	 "Return", _  ' End of 20
	 "#21",_  ' D D D D A A D C B A G  = > 21
	 	"@4", "V0000", "N3E41","G6", "G3", "Loop 4 times", _ ' D D D D
	 	"@2", "V0000", "N39__","G6", "G4", "Loop twice", _ ' A A
 	 			"V0000", "N3E41","G6", "G3", _  ' D
 	 			"V0000", "N3C__","G6", "G3", _  ' C
 	 			"V0000", "N3B3E","G6", "G3", _  ' B
 	 			"V0000", "N39__","G6", "G3", _  ' A
 	 			"V0000", "N373B","G6", "G4", _  ' G
 	 			"G4",_
	 "Return", _  ' End of 21
	 "#5", "@8", "_","Loop", _ ' 1/16 (Round)
	 "#4", "@4", "_","Loop",   _  ' 1/8 (White)
	 "#3", "@2","_","-0808","Loop",  _ ' 1/4 (Black)	
	 "#2", "_","-0808",  _ ' 1/2  (Croche)
	 "#1", "_","-0808","V0000",  _ ' 1/1 (Double Croche)
	 "Return", _
	 "#6", "V4040", _'"r@2","+2020","_","Loop","V4040", _ ' 3/4
	 "Return"}  ' End of 3 and 4
	
	
	
	Print "RetroSound with "+SOUNDLIBNAME+" v1.1"
	Print SOUNDLIBNAME+".1) Sequencer test, with a crappy music compo, sorry but I'm not musician"
	Print "===> Press any key to start, press ESCAPE to quit sequencer test"
	Sleep
	k = inkey
   Dim sseq As Sequencer
   sseq.load(rs,s())
   sseq.play()
   Do
   	sseq.tick
   	'Sleep 1,1
   Loop While MultiKey(FB.SC_ESCAPE)=0
   sseq.stop()
	Print ""  
	Print SOUNDLIBNAME+".2)QB Style sound with SINUS, SAW, SQUARE, SPECIAL and NOISE waveform "
	rs.setDefault(0,j,128) 
	rs.setDefault(1,j,128) 
	Dim kb(0 To 255) As Integer
	For i = 0 To 255 : kb(i)=i mod 128 : Next i 
	kb(Asc("q"))=60
	kb(Asc("z"))=61
	kb(Asc("s"))=62
	kb(Asc("e"))=63
	kb(Asc("d"))=64
	kb(Asc("f"))=65
	kb(Asc("t"))=66
	kb(Asc("g"))=67
	kb(Asc("y"))=68
	kb(Asc("h"))=69
	kb(Asc("u"))=70
	kb(Asc("j"))=71
	kb(Asc("k"))=72
	kb(Asc("o"))=73
	kb(Asc("l"))=74
	kb(Asc("p"))=75
	kb(Asc("m"))=76

	
For j = SINE To NOISE
	
	If j = 4 Then j = 15
	'set default waveform
	rs.setDefault(0,j,128) ' channel 0 , waveform j, volume 128 (0 silence , 255 full)
	
	Print SOUNDLIBNAME+".2.0.";Str(j);") Test";
	Select Case j
		Case 0 : Print " SINUS ";
		Case 1 : Print " SAW ";
		Case 2 : Print " SQUARE ";
		Case 3 : Print " SPECIAL ";
		Case 15 : Print " NOISE (random) ";
	End Select
	Print "wave form"
	Print "===> Press a key to start"
	sleep
	k = inkey
	'QB like coding
	Print SOUNDLIBNAME+".2.1.";Str(j);") 3 tied notes in blocking mode (implicit Sleep used)"
	rs.sound 440,400
	rs.sound 220,400
	rs.sound 110,400
	Sleep 800


	Print SOUNDLIBNAME+".2.2.";Str(j);") 3 untied notes in blocking mode (implicit Sleep used)"
	rs.sound 440,400.100
	rs.sound 220,400.100
	rs.sound 110,400.100
	Sleep 800

	Print SOUNDLIBNAME+".2.3.";Str(j);") 3 notes in non-blocking mode (need explicit sleep to do the delay)"
	rs.sound 440,400,0
	Sleep 400,1 ' arbitrary wait for end of sound
	rs.tick
	rs.sound 220,400,0
	Sleep 400,1 ' arbitrary wait for end of sound
	rs.tick
	rs.sound 110,400,0
	Sleep 400,1 ' arbitrary wait for end of sound
	rs.tick
	Sleep 800

	Print SOUNDLIBNAME+".2.4.";Str(j);") 3 tied notes in buffered mode (cummulate notes then wait for end)"
	rs.sound 440,400,2
	rs.sound 220,400,2
	rs.sound 110,400,2
	Do 'wait for end of play
		rs.tick
	Loop while rs._channel(0).isOn
	Sleep 800
	
	Print SOUNDLIBNAME+".2.5.";Str(j);") 3 un-tied notes in buffered mode (cummulate notes then wait for end)"
	rs.sound 440,400.100,2
	rs.sound 220,400.100,2
	rs.sound 110,400.100,2
	Do 'wait for end of play
		rs.tick
	Loop while rs._channel(0).isOn
	Sleep 800
	
	'Chromatic ledder
	Print SOUNDLIBNAME;".2.6.";Str(j);") Chromatic scale"
	For i = 0 To -127 Step -1
		rs.sound i,50
	Next
	Sleep 800
	
	' very classic siren
	Print SOUNDLIBNAME+".2.7.";Str(j);") Classic Siren"
	For i = 55 To 800
		rs.sound i,5
		If MultiKey(FB.SC_ENTER) Then Exit for
	Next
	For i = 800 To 55 Step -1
		rs.sound i,5
		If MultiKey(FB.SC_ENTER) Then Exit for
	Next

	Print SOUNDLIBNAME+".2.8.";Str(j);") Volume test"
	For i = 0 To 255 Step 2
		rs.setDefault(0,j,i)
		rs.sound 440,50
		If MultiKey(FB.SC_ENTER) Then Exit for
	Next
	For i = 255 To 0 Step -2
		rs.setDefault(0,j,i)
		rs.sound 440,50
		If MultiKey(FB.SC_ENTER) Then Exit for
	Next

	rs.setDefault(0,j,128)
	Print ""	
	Print SOUNDLIBNAME+".2.9.";Str(j);") Non blocking play of 1000ms sound"
	Print "===> Play with any key(even ENTER or BACK-SPACE)... escape to finish"
	Do 
		k = InKey
		If k <> "" Then
			rs.sound -(kb(Asc(k))-12),300,0
		EndIf
		
		rs.tick()
		Sleep 1,1
	Loop While MultiKey(FB.SC_ESCAPE) = 0
	Print "": Print "": Print "===> GO TO NEXT WAVEFORM <===":Print ""
Next i	
Print SOUNDLIBNAME+".3) End of test"

Sleep
End

rdc · Post by **rdc** » Aug 17, 2007 14:20

Cool stuff.

DrV · Post by **DrV** » Aug 17, 2007 18:15

Very cool! However, there are some "scratchy" high-pitched noises on the sinus, saw, and square demonstrations - maybe it needs a low-pass filter? I don't know much about sound, so take it with a grain of salt. :)

EDIT: Here's an example on the sine wave chromatic scale:

EDIT 2: maybe a useful link? http://slack.net/~ant/bl-synth/

redcrab · Post by **redcrab** » Aug 17, 2007 18:48

Don't know why ...
each wave form is made with 16 samples only...
I don't know how FMOD manage it at high frequency :S
The principle used here is quite simple
each waveform with 16 samples represent 1 cycle
I say to FMOD that these waveform (FMOD sample) are looped then
when I want to listen a waveform at F hz i say to FMOD to play the sample at F*16 hz.... that all the stuff
May be there is some quantification noise stuff

BTW : I have updated the first Post with a tiny sequencer stuff ,multiplex multichannel with ability to have nested loop and nested sub sequences...
Just for fun... Not really appropriate for music but for SFX sequences.

Enjoy !

Dr_D · Post by **Dr_D** » Aug 17, 2007 19:40

This is pretty cool man! :)

maddogg6 · Post by **maddogg6** » Aug 17, 2007 19:57

DrV wrote:Very cool! However, there are some "scratchy" high-pitched noises on the sinus, saw, and square demonstrations -

yeah - I get the same thing, seems random tho... I get it with all the demos to some degree. the player piano/keyboard part is the worse - some keys consistently produce noise, while others are more intermittent.

?? just FYI - but this is cool stuff none the less....

edit: - what version of FMOD did you use ? maybe versions are significant..??

I have fmod V 3.7.5.0 according to the 'file version' windows explorer reports.
And Im using...

FreeBASIC Compiler - Version 0.18 (07-01-2007) for win32 (target:win32)
Copyright (C) 2004-2007 The FreeBASIC development team.

redcrab · Post by **redcrab** » Aug 17, 2007 21:33

I use the same FMOD version ( this is the latest FMOD 3 version... 3.7.5)...
...
Anyway, that looks really retro ;P
BTW I tested it under linux and it works fine... It seams to have the same "scratch noise"...

Have fun !

Lachie Dazdarian · Post by **Lachie Dazdarian** » Aug 18, 2007 1:35

Very cool stuff. Thanks for providing the code with a demo.

I kinda always hated PC Speaker, but this showed me it could produce good sounds. If ever venture into making a remake of some ancient game, your routines will most definitely be used for the sound.

redcrab · Post by **redcrab** » Aug 18, 2007 9:03

I'm Happy that pleased you..
The CSGP rules are modified according this new stuff
http://csgp.suret.net

Have fun !

redcrab · Post by **redcrab** » Aug 21, 2007 15:50

New updates:

Thanks to Joshy, now RetroSound works with FBSOUND...

There is some issues ... but I think it's a good start

Enjoy and have fun !

redcrab · Post by **redcrab** » Aug 22, 2007 9:26

redcrab wrote:New updates:

Thanks to Joshy, now RetroSound works with FBSOUND...

There is some issues ... but I think it's a good start

Enjoy and have fun !

FBSOUND issues fixed (1st post updated)

Now FMOD and FBSOUND plays are identical (almost I guess)

Enjoy

D.J.Peters · Post by **D.J.Peters** » Aug 22, 2007 11:31

not perfect but ok so far
good job

Joshy

redcrab · Post by **redcrab** » Aug 22, 2007 14:43

DrV wrote:Very cool! However, there are some "scratchy" high-pitched noises on the sinus, saw, and square demonstrations - maybe it needs a low-pass filter? I don't know much about sound, so take it with a grain of salt. :)

EDIT: Here's an example on the sine wave chromatic scale:

EDIT 2: maybe a useful link? http://slack.net/~ant/bl-synth/

Thanks for the link.... I thinks the strange noise at high frequency is the fx of the nyquist limit .. seen at http://slack.net/~ant/bl-synth/3.nyquist.html

redcrab · Post by **redcrab** » Aug 22, 2007 14:48

D.J.Peters wrote:not perfect but ok so far
good job

Joshy

Thanks.

I've a strange behaviour with FBSOUND...
if I use a fine good sine sample form ... when I switch the volume between 1.0 to 0.0 there is "tick" sound, I do not have it with fmod

? ? ?

redcrab · Post by **redcrab** » Aug 22, 2007 15:29

New Update

Sound can be buffered, so set of sounds can be played asynchronously of the program flow

First post updated .