fbsound 1.0 Win/Lin 32/64-bit (wav mp3 ogg mod it xm s3m)

[D.J.Peters]

Could you make fbs_Get_MasterPointers (@lpStart,@lpPlay,@lpEnd)?

You get the wave pointer only inside of the MasterChannelCallback see at "test15.bas"
By the way the current sound buffer of the master channel does not have any lpPlay or lpEnd position.
It's simple the whole current active playing buffer.

Again try "test15.bas"

Joshy

[dafhi]

i tried the callback method, the thread seemed to break my note on / off calculations from the main program loop

[D.J.Peters]

i tried the callback method, the thread seemed to break my note on / off calculations from the main program loop

Kids :) i can't help without any source code.

post your callback code.

do you read samples from master channel ?
do you write samples inside the master callback ?
do you in trouble with global vars inside the callback ?
...

Joshy

[dafhi]

I trashed the source, trying to rewrite for get_sound_pointers (yes i did have global vars), but that isn't working so great either.

Code: Select all

#Include "fbgfx.bi"

'' ----------------
'   Gfx
' ----------------

Dim Shared As Single	Wid = 800
Dim Shared As Single	Hgt = 360

Dim Shared As Single	WidM: WidM = Wid - 1
Dim Shared As Single	HgtM: HgtM = Hgt - 1
Dim Shared As Single	midx: midx = WidM / 2
Dim Shared As Single	midy: midy = HgtM / 2

Dim Shared As Single 	scale_y = 0.0005
Dim Shared As Single 	vispos_x
Dim Shared As Integer 	infopos_y

'' ----------------
'   Audio
' ----------------

#Include Once "fbsound.bi"
Dim Shared As Integer	nFrames = 800
Dim Shared As Integer	rate = 8000
Dim Shared As Integer	nChannels = 1
Dim Shared As Integer	Buffers = 1
Dim As Integer   		Device = 0

fbs_Init(rate,nChannels,Buffers,nFrames,Device)

Dim as FBS_SAMPLE ptr  lpSamples
Dim Shared As Integer waveSamps: waveSamps = 600 * nChannels
dim Shared As integer hWave
fbs_Create_Wave(waveSamps,@hWave,@lpSamples)

'' _Play_Wave(hWave, [nLoops], [sSpeed], [sVolume], [sPan],[@hSound])
fbs_Play_Wave(hWave,-1) 

Dim Shared As integer hSound
fbs_Create_Sound(hWave,@hSound)
fbs_Play_Sound(hSound,-1)


'' ----------------
'   Synth Common
' ----------------

#Ifndef SynthRunning
	Dim Shared As Integer	SynthRunning = TRUE
	Dim Shared As UByte 	Polyphony = 1
	
	dim Shared As single  synthVal
	Dim Shared As Integer SampsOld
	Dim Shared As Integer SampsNew
	Dim Shared As Integer FrameSamps
	Dim Shared As Integer PlaySamps
	Dim Shared As Integer FrameCheck
	Dim Shared As short ptr lpStart,lpPlay,lpEnd
	Dim Shared As short ptr lpPlayOld
	
	#Ifndef floor
	#Define floor(x) ((x*2.0-0.5)shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
	#define ceil(x) (-((-x*2.0-0.5)shr 1))
	#EndIf
	
	#Macro Modulus(pValue,pModulus)
	   pValue -= pModulus * floor(pValue / pModulus)
	#EndMacro
	
	#Ifndef TwoPi
	Const TwoPi = 8 * Atn(1)
	#EndIf
#EndIf

'' ----------------
'   Synth
' ----------------

Dim Shared As Single angle
Dim Shared As Single iangle = 4 * TwoPi / 215

Sub Synth_GetMarkers
	
	lpPlayOld = lpPlay
	
	fbs_Get_SoundPointers (hSound,@lpStart,@lpPlay,@lpEnd)
	'lpEnd -= 1
	
	Dim As Short ptr localPlay_ = lpPlay
	If nFrames < waveSamps Then
		'' attempt to get in front of sound ptr for reduced latency
		 
		'localPlay_ += nFrames * nChannels
	End If
	
	Dim As Integer lDelt = localPlay_ - lpEnd
	Modulus(lDelt,waveSamps)
	If lDelt > 0 Then
		lpPlay = lpStart + lDelt
	EndIf
	
	''prevent first frame overflow
	If FrameCheck = 0 Then
		SampsOld= SampsNew
		lpPlayOld = lpPlay
		FrameCheck = 1
	End If
End Sub

Function RenderNote(byval lpSt  as Short ptr, _
               byval lpEnd As Short Ptr, ByVal lRGB As UInteger=16777215) As Integer

	Dim As Integer nSamples = (lpEnd + 1 - lpSt) \ nChannels

	Dim As Integer retval = -1
	If nSamples = 0 Then retval = 0
    
	'Locate infopos_y,1
	'? (lpSt - lpStart)\ nChannels; " ";
	Modulus(infopos_y,3)
	infopos_y += 1

	vispos_x = (lpSt - lpStart) \ nChannels
    for index as integer = 0 to (nSamples - 1) * nChannels Step nChannels

    	PSet( vispos_x, midy + scale_y*lpSt[Index] ),0
    	lpSt[Index] = 5000 * Sin(angle)
    	PSet( vispos_x, midy + scale_y*lpSt[Index] ),lRGB

		''stereo
    	'lpSt[Index+1] = lpSt[Index]

    	angle += iangle
    	vispos_x += 1
    Next
    
    Return retval
End Function


Sub RenderSound

	Synth_GetMarkers
	
	SampsOld = SampsNew
	SampsNew = fbs_Get_PlayedSamples
	Dim As Integer samps_delt = SampsNew - SampsOld

	'' cpu is keeping up
	If samps_delt <= nFrames Then
		'If samps_delt > 0 Then
			If lpPlayOld <= lpPlay Then
				Dim As Integer color1 = 255*(1 + 256)
				RenderNote lpPlayOld, lpPlay - 1, color1
			Else
				RenderNote lpPlayOld, lpEnd
				vispos_x = 0
				Dim As Integer color2 = 255*256
				RenderNote lpStart, lpPlay - 1, color2
			End If
		'End If
	EndIf
	'? (lpPlayOld-lpStart)\nChannels; " "; 2; " "

End Sub

'' ----------------
'  Main
' ----------------

ScreenRes Wid,Hgt,32

using fb
Dim Shared As EVENT e

Do While SynthRunning
	If MultiKey(SC_ESCAPE) Then
		SynthRunning = FALSE
	EndIf
	If (ScreenEvent(@e)) Then
		Select Case e.type
		Case Event_Key_Release
			If e.scancode = SC_SPACE Then
				SynthRunning = FALSE
			EndIf
		End Select
	End If
	RenderSound
	Sleep 40
Loop

fbs_Destroy_Sound(@hSound)
fbs_Destroy_Wave(@hWave)

[dafhi]

I don't have the callback source anymore. I kept my loop however. I don't know how to do it without global vars

Code: Select all

Do While SynthRunning
	If MultiKey(SC_ESCAPE) Then
		SynthRunning = FALSE
	EndIf
	If (ScreenEvent(@e)) Then
		Select Case e.type
		Case Event_Key_Press
			ChordUDT.NoteOn( e.scancode, Rnd * 15 )
		Case Event_Key_Release
			ChordUDT.NoteOff( e.scancode, 0.2 )
		End Select
	End If
	RenderSound
	Sleep 10
Loop

[TJF]

...The problem is I am not getting a return value from fbs_Load_WAVFile....

if "test02.bas" is ok on your box
looks like your path/filename makes trouble.

I can't tell you what's going wrong without your source code.

Joshy

Mixed character encoding in source code and file/path name?

[dafhi]

some of us don't post source because we know you are very busy :-)
but thank you for your help

[D.J.Peters]

hello dafhi,
first of all why you don't use the default device settings ?
how ever if you need a total different setup you must check the curent setting after fbs_init()
i added this in your code:

Code: Select all

    print "before fbs_init():"
    print "SampleRate:" & rate
    print "nChanels  :" & nChannels
    print "nBuffers  :" & buffers
    print "nFrames   :" & nFrames
    fbs_Init(rate,nChannels,Buffers,nFrames,Device)
    print "after fbs_init():"
    print "SampleRate:" & fbs_Get_PlugRate()
    print "nChanels  :" & fbs_Get_PlugChannels()
    print "nBuffers  :" & fbs_Get_PlugBuffers()
    print "nFrames   :" & fbs_Get_PlugFrames()

The curent values on your box will not be the same as on other boxes.
By the way you will setup only one buffer (why ?)
There isn't any playback device with only one buffer !
One buffer is playing ever while the others are curently mixed or filled with samples from your code.
The code you posted does exactly what i would accept from.
If you will get in sync you should use a callback may be a SoundCallback.
You are waiting in the main loop 40 milli seconds
looks like you will never pefect in sync with the playback device.
Is this the primary problem ?
Don't foreget your gfx code needs time too !

Again if you try to create a synthy with FBSound
use the default settings and a SoundCallback.
Don't use any own hardcoded values.
For example if your sound device can playback 3 buffers with 800 samples per buffer
how should work your synth on a device with 1024 samples per buffers ?
You know ?

How do you will create the notes for the softsynth via MIDI or the PC keyboard or from a file with notes ?
What are the fastes speed i mean how many beets per minute and ... ?

I can post an simple example as starting point if you need it.

Yes you are right i'm busy but from time to time i read the forum here.

Joshy

[dafhi]

I'm surprised to have found my callback synthesizer.

Running this, if you press computer keys quickly, sometimes the note_off is incorrect. I thought due to callback competing against the main loop.

[Edit:] sub Note_Off() update

Code: Select all

#Include "fbsound.bi"

Declare Sub MyCallback(byval lpSamples  as FBS_SAMPLE ptr, byval nChannels  as integer, byval nSamples   as integer)

Dim Shared As Integer	Buffers = 1
Dim Shared As Integer	nChannels = 2
Dim Shared As Integer	rate = 44100

Dim As Integer   	Device = 0
Dim As Integer		nFrames = 599 ''low latency

fbs_Init(rate,nChannels,Buffers,nFrames,Device)

fbs_Set_MasterCallback(@MyCallback)

Dim as FBSBOOLEAN 	ok=fbs_Enable_MasterCallback


'' --------------
'  controller
' --------------

Dim As UByte 	Polyphony = 8

#ifndef floor
#Define floor(x) ((x*2.0-0.5)shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#define ceil(x) (-((-x*2.0-0.5)shr 1))
#endif

#Macro Modulus(pValue,pModulus)
   pValue -= pModulus * floor(pValue / pModulus)
#EndMacro

Type increments
    as Single           func
    as Single           func2
    as Single           func3
end type

type chan
    as Single           func
    as Single           func2
    as Single           func3
    as increments       i
end type

type notevars
    as chan             chanL
    as chan             chanR
    as single           volume
    as single           baseVol
    as single           baseFreq
    as single           modval
    As Integer			scancode
    As UInteger			release_samples
    As Single			release_iVol
End Type

Const           basefreq = 1 / 200
Sub SetFreq(ByRef nvars as notevars, ByVal scancode As Integer, byval note as single)
    nvars.baseFreq = 2 ^ (note / 12)
    nvars.basevol = 1

    nvars.chanL.i.func = basefreq * nvars.baseFreq
    nvars.modval = 1
    nvars.volume = 2500 * nvars.basevol
    
    nvars.chanL.func = Rnd * nvars.modval
    nvars.chanR.func = Rnd * nvars.modval

    nvars.chanR.i.func = nvars.chanL.i.func
    nvars.chanL.i.func2 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.chanL.i.func3 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.chanR.i.func2 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.chanR.i.func3 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.release_samples = -1
    nvars.release_iVol = 0
    nvars.scancode = scancode
End Sub

Dim Shared As notevars	shared_chord(polyphony - 1)
Dim Shared As Single	scale(7) = {0,2,4,5,7,9,11,12}
Dim Shared As Integer	NoteOn_Ref(255)

Type ChordType
	As Integer			StackPtr = -1
	As Integer			scale_mod
	As Integer			note_mod
	Declare sub			NoteOn_Raw(ByVal scancode As Integer, ByVal note_val As single)
	Declare sub			NoteOn(ByVal scancode As Integer, ByVal noteNr As integer)
	Declare sub			NoteOff(ByVal scancode As Integer,ByVal ReleaseTime As Single = 1.0)
	Declare sub			RemoveNote(ByVal Index As integer)
	Declare Sub			initialize
	Declare Sub 		Program_Exit
End Type
#Macro macro_NoteOn_Common()
	If stackptr = UBound(shared_chord) Then	Exit Sub
	Dim As Integer	temp = StackPtr + 1
	If temp = 0 Then
	Else
		If shared_chord(temp).release_samples <> 0 Then
		? "idx ";temp; " release "; shared_chord(temp).release_samples
		sleep
		'Exit Sub
		End If
	EndIf
	'
	'EndIf
	NoteOn_Ref(scancode) = temp
	StackPtr = temp
#EndMacro
Sub ChordType.NoteOn(ByVal scancode As Integer, ByVal noteNr As Integer)
	macro_NoteOn_Common()
	Dim As Integer octave = noteNr \ scale_mod
	Modulus(noteNr, scale_mod)
	SetFreq shared_chord(StackPtr), scancode, scale(noteNr) + octave * note_mod
End Sub
Sub ChordType.NoteOn_Raw(ByVal scancode As Integer, ByVal note_val As single)
	macro_NoteOn_Common()
	SetFreq shared_chord(StackPtr), scancode, note_val
End Sub
Sub ChordType.NoteOff(ByVal scancode As Integer,ByVal ReleaseTime As Single)
	Dim As Integer Ptr pRef = @NoteOn_Ref(scancode)
	If scancode = shared_chord(*pRef).scancode Then
		With shared_chord(NoteOn_Ref(scancode))
			ReleaseTime *= rate
			If .release_samples < ReleaseTime Then Exit sub
			.release_samples = ReleaseTime
			.release_iVol = -.volume / (ReleaseTime * nChannels)
		End With
	End If
End Sub
Sub ChordType.initialize
	scale_mod = UBound(scale)
	note_mod = scale(scale_mod)
End Sub
Sub ChordType.Program_Exit
	StackPtr = -1 'skip callback loop
End Sub
Sub ChordType.RemoveNote(ByVal Index As integer)
	Dim As Integer ctrl_Ref = shared_chord(StackPtr).scancode
	NoteOn_Ref(ctrl_Ref) = Index
	Swap shared_chord(StackPtr), shared_chord(Index)
	StackPtr -= 1
End Sub

Dim Shared As ChordType		mychord

'' ------------
'  synth
' ------------- 

#Macro t_wave_macro(a)
    a -= floor(a)
    if a > 0.75 then
        a -= 1
    elseif a > 0.25 then
        a = 0.5 - a
    end if
#EndMacro

function twave(byval input_ as double) as double
    t_wave_macro(input_)
    return input_
End function

#Macro z_chanMod(pChan)
    Modulus(pChan.func,pNote.modval)
    Modulus(pChan.func2,pNote.modval)
    Modulus(pChan.func3,pNote.modval)
#EndMacro

#Macro z_WriteSample_AddDynamics(pChan,pSample)
    sVal += twave(pChan.func2)
    sVal += twave(pChan.func3)
    pChan.func2 += pChan.i.func2
    pChan.func3 += pChan.i.func3
#EndMacro

#Macro WriteSample(pChan,pSample)
    sVal = twave(pChan.func)
    pChan.func += pChan.i.func
    
    z_WriteSample_AddDynamics(pChan,pSample)
    
    pSample += sVal * pNote.Volume
    pNote.Volume += pNote.release_iVol
#EndMacro

Function RenderNote(byval lpSamples  as FBS_SAMPLE ptr, _
               byval nChannels  as integer, _
               byval nSamples   as integer, _
               ByRef pNote as notevars) As Integer
               
	Dim As Integer retval = -1
	
	If pNote.release_samples < nSamples Then
		nSamples = pNote.release_samples
		retval = 0
	EndIf
    
    dim as single   sVal
    for index as integer = 0 to (nSamples - 1) * nChannels Step nChannels
        WriteSample(pNote.chanL, lpSamples[index])
        WriteSample(pNote.chanR, lpSamples[index+1])
    next
    pNote.release_samples -= nSamples

    z_chanMod(pNote.chanL)
    z_chanMod(pNote.chanR)

    Return retval
End Function

Sub MyCallback(byval lpSamples  as FBS_SAMPLE ptr, _
               byval nChannels  as integer, _
               byval nSamples   as integer)
   
    For J as integer = mychord.StackPtr To 0 Step -1
        If RenderNote( lpSamples, nChannels, _
        	nSamples, shared_chord(J) ) = 0 Then
        	? " Released"
        	mychord.RemoveNote J
		ElseIf J = 0 Then
			? shared_chord(J).release_samples
        EndIf
    next
end sub


mychord.initialize

Randomize

#Include "fbgfx.bi"
using fb

Dim as EVENT        e

ScreenRes 640,480,32

Dim As Integer showhelp = TRUE

Do

	If MultiKey(SC_ESCAPE) Then Exit Do
	
	If showhelp Then
		Cls
		? "press some keys "
		If mychord.StackPtr = 0 Then
		showhelp = FALSE
		End If
	EndIf
	
	
	If (ScreenEvent(@e)) Then
		Select Case e.type
		Case Event_Key_Press
			mychord.NoteOn( e.scancode, Rnd * 15 )
		Case Event_Key_Release
			mychord.NoteOff( e.scancode, 0.2 )
		End Select
	End If
	
	Sleep 1
Loop

mychord.Program_Exit

As for Buffers, I am just using to make code easy to read. If I was a somewhat experienced noob, and reading for the first time, I might think "3 Buffers?!"

[dafhi]

I think I fixed my on/off architecture. No more stuck notes, as far as I have tested.

Code: Select all

''Debugger
Dim Shared As Integer mIndex
Dim Shared As Integer mCallB


'' Control Var
Dim Shared As UByte 	Polyphony = 3

#Include "fbsound.bi"

Declare Sub MyCallback(byval lpSamples  as FBS_SAMPLE ptr, byval nChannels  as integer, byval nSamples   as integer)

Dim Shared As Integer	Buffers = 1
Dim Shared As Integer	nChannels = 2
Dim Shared As Integer	rate = 44100

Dim As Integer   	Device = 0
Dim As Integer		nFrames = 599 ''low latency

fbs_Init(rate,nChannels,Buffers,nFrames,Device)

fbs_Set_MasterCallback(@MyCallback)

Dim as FBSBOOLEAN 	ok=fbs_Enable_MasterCallback


'' --------------
'  controller
' --------------

#Ifndef floor
#Define floor(x) ((x*2.0-0.5)shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#define ceil(x) (-((-x*2.0-0.5)shr 1))
#endif

#Macro Modulus(pValue,pModulus)
   pValue -= pModulus * floor(pValue / pModulus)
#EndMacro

Type increments
    as Single           func
    as Single           func2
    as Single           func3
end type

type chan
    as Single           func
    as Single           func2
    as Single           func3
    as increments       i
end type

type notevars
    as chan             chanL
    as chan             chanR
    as single           volume
    as single           baseVol
    as single           baseFreq
    as single           modval
    As Integer			scancode
    As UInteger			release_samples
    As Single			release_iVol
End Type

Const           basefreq = 1 / 200
Sub SetFreq(ByRef nvars as notevars, ByVal scancode As Integer, byval note as single)
    nvars.baseFreq = 2 ^ (note / 12)
    nvars.basevol = 1

    nvars.chanL.i.func = basefreq * nvars.baseFreq
    nvars.modval = 1
    nvars.volume = 2500 * nvars.basevol
    
    nvars.chanL.func = Rnd * nvars.modval
    nvars.chanR.func = Rnd * nvars.modval

    nvars.chanR.i.func = nvars.chanL.i.func
    nvars.chanL.i.func2 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.chanL.i.func3 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.chanR.i.func2 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.chanR.i.func3 = nvars.chanL.i.func * (1 + 0.003 * (Rnd - 0.5))
    nvars.release_samples = -1
    nvars.release_iVol = 0
    nvars.scancode = scancode
End Sub

Dim Shared As notevars	shared_chord(1 To polyphony)
Dim Shared As Single	scale(7) = {0,2,4,5,7,9,11,12}
Dim Shared As Integer	NoteOn_Ref(255)

#Macro macro_TestCallB_Interrupt(pStr)
If mCallB <> 0 Then
	Locate 4,1
	? pStr
EndIf
#EndMacro

Type ChordType
	As Integer			StackPtr
	As Integer			scale_mod
	As Integer			note_mod
	Declare Function	NoteOn(ByVal scancode As Integer, ByVal noteNr As integer) As Integer
	Declare sub			NoteOff(ByVal scancode As Integer,ByVal ReleaseTime As Single = 1.0)
	Declare sub			RemoveNote(ByVal Index As integer)
	Declare Sub			initialize
	Declare Sub 		Program_Exit
End Type
Function ChordType.NoteOn(ByVal scancode As Integer, ByVal noteNr As integer) As Integer
mCallB = 0
	Dim As Integer SUCCESS = FALSE
	Dim As Integer Index = 1
	
	Dim As UInteger	samps = shared_chord(Index).release_samples
	For idx As integer = 2 To Polyphony
		If shared_chord(idx).release_samples < samps Then
			samps = shared_chord(Idx).release_samples
			Index = idx
		End If
	Next
	
	If StackPtr < UBound(shared_chord) Then
		SUCCESS = TRUE
		NoteOn_Ref(scancode) = Index
		StackPtr += 1
	Else
		SUCCESS = TRUE
		'NoteOn_Ref( shared_chord(Index).scancode ) = 0
		NoteOn_Ref(scancode) = Index
	EndIf
	mIndex = Index
	
	'Locate 2, 1
	? "on";mIndex
		
	Dim As Integer octave = noteNr \ scale_mod
	Modulus(noteNr, scale_mod)
	SetFreq shared_chord(Index), scancode, scale(noteNr) + octave * note_mod
	macro_TestCallB_Interrupt("Note On: CallB Interrupt")
	Return SUCCESS
End Function
Sub ChordType.NoteOff(ByVal scancode As Integer,ByVal ReleaseTime As Single)
mCallB = 0
	Dim As Integer Ptr pRef = @NoteOn_Ref(scancode)
	If scancode = shared_chord(*pRef).scancode Then
		With shared_chord(*pRef)
			ReleaseTime *= rate
			'Locate 2, 20
			? "off";*pRef
			If .release_samples < ReleaseTime Then
				? "Bad Note Off - rel samps "; .release_samples
			EndIf
			.release_samples = ReleaseTime
			.release_iVol = -.volume / (ReleaseTime)' * nChannels)
		End With
		*pRef = 0
	Else
		? "off mismatch";scancode;*pRef;shared_chord(*pRef).scancode
	End If
	macro_TestCallB_Interrupt("Note Off: CallB Interrupt")
End Sub
Sub ChordType.initialize
	scale_mod = UBound(scale)
	note_mod = scale(scale_mod)
End Sub
Sub ChordType.Program_Exit
	StackPtr = -1 'skip callback loop
End Sub
Sub ChordType.RemoveNote(ByVal Index As integer)
	Dim As Integer Ptr pRef = @NoteOn_Ref( shared_chord(Index).scancode )
	'Locate 3, 20
	If *pRef <> 0 Then
		? "Bad Remv";Index, *pRef
	Else
		? "Remv"; Index
		StackPtr -= 1
		*pRef = 0
	End If
End Sub

Dim Shared As ChordType		mychord

'' ------------
'  synth
' ------------- 

#Macro t_wave_macro(a)
    a -= floor(a)
    if a > 0.75 then
        a -= 1
    elseif a > 0.25 then
        a = 0.5 - a
    end if
#EndMacro

function twave(byval input_ as double) as double
    t_wave_macro(input_)
    return input_
End function

#Macro z_chanMod(pChan)
    Modulus(pChan.func,pNote.modval)
    Modulus(pChan.func2,pNote.modval)
    Modulus(pChan.func3,pNote.modval)
#EndMacro

#Macro z_WriteSample_AddDynamics(pChan,pSample)
    sVal += twave(pChan.func2)
    sVal += twave(pChan.func3)
    pChan.func2 += pChan.i.func2
    pChan.func3 += pChan.i.func3
#EndMacro

#Macro WriteSample(pChan,pSample)
    sVal = twave(pChan.func)
    pChan.func += pChan.i.func
    
    z_WriteSample_AddDynamics(pChan,pSample)
    
    pSample += sVal * pNote.Volume
#EndMacro

Function RenderNote(byval lpSamples  as FBS_SAMPLE ptr, _
               byval nChannels  as integer, _
               byval nSamples   as integer, _
               ByRef pNote as notevars, _
               byval Index   as Integer) As Integer
               
	Dim As Integer retval = -1
	
	If pNote.release_samples = 0 Then
		Dim As Integer Ptr pRef = @NoteOn_Ref( pNote.scancode )
		'Locate 3, 20
		'? *pRef, Index
		If *pRef = Index Then
			mychord.StackPtr -= 1
			*pRef = 0
		End If
	Else 'release should be > 0
		If pNote.release_samples < nSamples Then
			nSamples = pNote.release_samples
			retval = 0
		EndIf
	    '/'
	    dim as single   sVal
	    for index as integer = 0 to (nSamples - 1) * nChannels Step nChannels
	        WriteSample(pNote.chanL, lpSamples[index])
	        WriteSample(pNote.chanR, lpSamples[index+1])
		    pNote.Volume += pNote.release_iVol
	    next'/
	    pNote.release_samples -= nSamples
	
	    z_chanMod(pNote.chanL)
	    z_chanMod(pNote.chanR)
	EndIf
    Return retval
End Function

Sub MyCallback(byval lpSamples  as FBS_SAMPLE ptr, _
               byval nChannels  as integer, _
               byval nSamples   as integer)
   mCallB += 1
    For J as integer = 1 To Polyphony
        If RenderNote( lpSamples, nChannels, _
        	nSamples, shared_chord(J), J ) = 0 Then
        	'? " Released", Rnd
        	mychord.RemoveNote J
        EndIf'/
    next
end sub


mychord.initialize

Randomize

#Include "fbgfx.bi"
using fb

Dim as EVENT        e

ScreenRes 640,480,32

Dim As Integer showhelp = TRUE

Do

	If MultiKey(SC_ESCAPE) Then Exit Do
	
	If showhelp Then
		Cls
		? "press some keys "
		If mychord.StackPtr = 0 Then
		showhelp = FALSE
		End If
	EndIf
	
	
	If (ScreenEvent(@e)) Then
		Select Case e.type
		Case Event_Key_Press
			mychord.NoteOn( e.scancode, Rnd * 15 )
		Case Event_Key_Release
			mychord.NoteOff( e.scancode, 1.0 )
		End Select
	End If
	
	Sleep 10
Loop

mychord.Program_Exit

[D.J.Peters]

Looks like that you are on the right way with a callback.
I know a callback is a very time sensitive task.
You should generate new wave shapes outside the callback.
Inside the callback copy the new samples to the buffer.
I mean do only fast things inside the callback.

Joshy

[dafhi]

Finally figured out the play pointer. Any idea why the pitch changes? I tried on Linux and Win, both seem to have the same result

[SOLVED] - pitch change caused by single precision error. If I change

Code: Select all

Dim Shared As Single angle
Dim Shared As Single iangle = 4 * TwoPi / 200

to this, everything is fine:

Code: Select all

Dim Shared As Double angle
Dim Shared As Single iangle = 4 * TwoPi / 200

source updated

Code: Select all

#Include "fbgfx.bi"

'' ----------------
'   Gfx
' ----------------

Dim Shared As Single   Wid = 400
Dim Shared As Single   Hgt = 300
Dim Shared As Single   midy: midy = Hgt * 0.5

'' ----------------
'   Audio
' ----------------

#Include Once "fbsound.bi"
Dim Shared As Integer   nFrames = 1100
Dim Shared As Integer   rate = 44100 \ 1
Dim Shared As Integer   nChannels = 1
Dim Shared As Integer   Buffers = 1
Dim As Integer         	Device = 0

fbs_Init(rate,nChannels,Buffers,nFrames,Device)

Dim Shared As Integer 	waveSamps: waveSamps = ( nFrames * 2 + 0 ) * nChannels
dim Shared As integer 	hWave
Dim Shared As integer 	hSound
Dim as FBS_SAMPLE ptr  	lpSamples
fbs_Create_Wave(waveSamps,@hWave,@lpSamples)
fbs_Create_Sound(hWave,@hSound)
fbs_Play_Sound(hSound,-1)

'' ----------------
'   Synth Common
' ----------------

Dim Shared As Integer   SynthRunning = TRUE

#Ifndef TwoPi
Const TwoPi = 8 * Atn(1)
#EndIf

'' ----------------
'   Synth
' ----------------

Dim Shared As Double angle
Dim Shared As Single iangle = 4 * TwoPi / 200
Dim Shared As Single valu
Dim Shared As Single vis_x

Sub RenderNote(byval lpSt As Short ptr, byval lpEnd As Short Ptr)
             	
	Dim As Short Ptr lpPos2 = lpSt + nChannels - 1
    for lpPos As Short Ptr = lpSt To lpEnd Step nChannels
    
		PSet(vis_x, midy + *lpPos * 0.01),0

    	valu = 3000 * Sin(angle)

		''stereo
		*lpPos2 = valu
		*lpPos = valu
		
		PSet(vis_x, midy + *lpPos * 0.01),16777215
		vis_x += 1

		lpPos2 += nChannels
		angle += iangle
    Next
    
End Sub

Dim Shared As Integer SampsOld
Dim Shared As Integer SampsNew
Dim Shared As short ptr lpStart,lpPlay,lpEnd

Sub RenderSound

	fbs_Get_SoundPointers (hSound,@lpStart,@lpPlay,@lpEnd)
	lpEnd -= nChannels
	
	SampsOld = SampsNew
	SampsNew = fbs_Get_PlayedSamples
	Dim As Integer samps_delt = SampsNew - SampsOld
	
	'' cpu is keeping up
	If samps_delt <= nFrames Then
		If samps_delt > 0 Then
			vis_x = 0
			Dim As Short Ptr lpEnd_ = lpPlay + (samps_delt - 1) * nChannels
			If lpEnd < lpEnd_ Then
				Dim As Integer lDelt = (lpEnd_ - lpEnd)
	            lpEnd_ = lpStart + lDelt - nChannels
	            RenderNote lpPlay, lpEnd
	            RenderNote lpStart, lpEnd_
			Else
	            RenderNote lpPlay, lpPlay + (samps_delt - 1) * nChannels
			EndIf
		End If
	EndIf

End Sub

'' ----------------
'  Main
' ----------------

ScreenRes Wid,Hgt,32

using fb
Dim Shared As EVENT e

Do While SynthRunning
   If (ScreenEvent(@e)) Then
      Select Case e.type
      Case Event_Key_Release
         If e.scancode = SC_ESCAPE Then
            SynthRunning = FALSE
         EndIf
      End Select
   End If
   RenderSound
   Sleep 1
Loop

fbs_Destroy_Sound(@hSound)
fbs_Destroy_Wave(@hWave)

[TheIronPainter]

I am a complete beginner to FBSound and an intermediate programmer but new to FreeBASIC.

If I have a game directory: C:/users/poolday/desktop/game

how do I use Fbsound include files etc...?

I copied everything from FBSound to Game but then I get this error:

C:\Users\Poolday\Desktop\FreeBasic\bin\win32\ld.exe: cannot find -lfbsound

What should I do?

[D.J.Peters]

from my point of view "C:/users/poolday/desktop/game" isn't the right place for source code projects.

how ever copy the fbsound/lib and fbsound/inc folder to your project folder

C:/users/poolday/desktop/game
C:/users/poolday/desktop/game/lib
C:/users/poolday/desktop/game/inc
C:/users/poolday/desktop/game/src/yourgame.bas

"yourgame.bas"

Code: Select all

#include "../inc/fbsound.bi"
fbs_init()
...
sleep

[TheIronPainter]

Thanks! But a problem...I'm getting Fbs_init error...


The /inc and /lib are copied, my test.bas file is in /src and my sounds are in /sound

Here is a sample of my code.

'$lang: "fblite"
#include ".../inc/fbsound.bi"


' only if not same as exe path
' fbs_Set_PlugPath("./")

const data_path = "c:/user/poolday/desktop/game/sound/"
dim as integer hWave 'Declare the sound variable

dim as FBSBOOLEAN ok
ok=fbs_Init(48000)
if ok=false then
? "error: fbs_Init() !"
? FBS_Get_PlugError()
beep:sleep:end 1
end if

ok=fbs_Load_WAVFile(data_path & "Building1.wav",@hWave)
if ok=false then
? "error: fbs_Load_WAVFile() !"
beep:sleep:end 1
end if

'get next free playback channel or create one
ok=fbs_Play_Wave(hWave)
if ok=false then
? "error: fbs_Play_Wave() !"
beep:sleep:end 1
end if