Sound from keypress

Basic Coder · Post by **Basic Coder** » Mar 31, 2008 9:48

Hi,

I would like a buzzing sound when holding down a particular key.

In this case it is the left arrow key. I tried the BEEP command
but it wasn't suitable as it freezes the program and gives a beep
of a fixed length.

I am using Windows XP.

Any suggestions gratefully received.

-
Basic Coder

Code: Select all

do
  if multikey(&h4B) then
    print "|";
'    beep
  else
    print "-";
  end if
  sleep 10
loop while not multikey(&h1)

sleep
end

redcrab · Post by **redcrab** » Mar 31, 2008 10:26

You've to know that FB does not have native full feature sound support but FMOD, BASS, FBSOUND ... are well supported

For me I use FMOD and FBSSOUND to do retro(QB alike) sound stuff (cross platform libs)
but you may find out more Windows specific support...
let's do a search with QB PLAY SOUND in this forum...

Anyway
Here is your code intergrated into my retrosound source lib
you may need fmod.dll version 3.7.5 (latest version 3)
or you may choose also FBSound

more info and full example at http://csgp.suret.net/blabla/viewtopic.php?f=5&t=22

see at the end of the following code to see your code in context...

Hope that help

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
   
   j = 2 ' 0 = sinus, 1= SAW, 2 = SQuare, 3=Special, 15 = noise
   rs.setDefault(0,j,128) ' channel 0 , waveform j, volume 128 (0 silence , 255 full)
   

Do
  If multikey(&h4B) Then
    Print "|";
   rs.sound 440,40,0  ' 440 hz 40 ms, 
  Else
    Print "-";
  End If
  Sleep 10
  rs.tick
Loop While Not multikey(&h1)

Sleep
End

MichaelW · Post by **MichaelW** » Mar 31, 2008 14:20

Windows only, Windows 95/98/ME will ignore the specified frequency and duration (and you will probably have the “freeze” problem), and it uses the system speaker, except under Windows 95/98/ME on systems with a sound card, where the function plays the default sound event.

Code: Select all

#include "fbgfx.bi"
#include "windows.bi"
const FREQ = 500
const DURATION = 30
do
  if multikey(FB.SC_LEFT) then
    Beep_(FREQ,DURATION)
  end if
loop until multikey(FB.SC_ESCAPE)

redcrab · Post by **redcrab** » Mar 31, 2008 14:53

It still freezing ....

check this code out...

Code: Select all

#include "fbgfx.bi"
#include "windows.bi"
Const FREQ = 500
Const DURATION = 100

Do
  If multikey(&h4B) Then
    Print "|";
    Beep_(FREQ,DURATION)
  Else
    Print "-";
  End If
  Sleep 10
Loop While Not multikey(&h1)
Sleep
End

phishguy · Post by **phishguy** » Mar 31, 2008 15:25

Here's another way. Obviously the tada.wav could be changed to something that sounds more appropriate.

Code: Select all

#include "windows.bi"
#include "win/mmsystem.bi"
Dim t As Single
Do    
    If Multikey(&h4B) Then
        Print "|";
        If Timer - t > 1 Then
            sndplaysound("tada.wav",snd_async)
            t = Timer
        End If
    Else
        Print "-";
    End If
    
    Sleep 10
Loop While Not Multikey(&h1)
Sleep
End

phishguy · Post by **phishguy** » Mar 31, 2008 15:39

Using recycle.wav and changing to "if timer-t > .5 then" makes an interesting sound. I'm not sure if it's the kind of sound your looking for though.

Zippy · Post by **Zippy** » Mar 31, 2008 16:15

This little code bit removes the "freezing". I may be misusing CondWait and CondSignal (note: requires newer fb version 0.18)..

Code: Select all

#include "fbgfx.bi"
#include "windows.bi"
Const FREQ = 500
Const DURATION = 100
'
declare sub beep_me()
dim thrdptr as any ptr
thrdptr=ThreadCreate(@beep_me)
'
dim shared beepme as any ptr
beepme=CondCreate()
'
dim shared as integer terminate=0
'
do
  if multikey(&h4b) then
    print "|";
    CondSignal(beepme)
  else
    print "-";
  end if
  sleep 10
loop while not multikey(&h1)
'
while inkey<>"":wend
terminate=1
CondSignal(beepme) 'needed to terminate the thread
ThreadWait(thrdptr)
CondDestroy(beepme)
'
print
print "Done, Sleeping.."
sleep
end
'
sub beep_me()
    while terminate=0
        CondWait(beepme)
        if terminate=0 then
            Beep_(FREQ,DURATION)
        end if
    wend	
end sub

redcrab · Post by **redcrab** » Mar 31, 2008 16:22

That's cool !

notthecheatr · Post by **notthecheatr** » Mar 31, 2008 16:59

Most PCs still give you a beep with

Code: Select all

Print Chr(7)

However, you can't specify the frequency or duration. Also, I've only tried it on desktops - it may not work at all on laptops.

Basic Coder · Post by **Basic Coder** » Mar 31, 2008 23:03

Thank you everybody. You have given me the solutions
to the problem and more ...

Zippy had the most suitable solution for making use
of the pc speaker, however I will have to use his code
without understanding as I don't know anything about
using threads. I used assembler code and the pc timer
interrupt on the old pc to play music out the speaker
while other things were running.

Basic Coder

notthecheatr · Post by **notthecheatr** » Apr 01, 2008 1:04

Threads are basically the equivalent of doing that in a protected mode operating system ;)