Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Audio Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Audio/PortAudio
This example is the version from Tue, 28th Oct 2019.
Project "PortAudio.xojo_binary_project"
MenuBar Menu
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu7 = ""
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
MenuItem UntitledMenu6 = ""
MenuItem UntitledMenu5 = ""
MenuItem UntitledMenu4 = ""
End MenuBar
Class App Inherits Application
EventHandler Sub Open()
dim f as FolderItem = SpecialFolder.Desktop.Child("test.log")
if PortAudioMBS.SetDebugLogFile(f) then
else
Break
end if
End EventHandler
End Class
Class InfoWindow Inherits Window
Control ListBox1 Inherits Listbox
ControlInstance ListBox1 Inherits Listbox
EventHandler Sub ExpandRow(row As Integer)
dim o as Object
dim h as PortAudioHostApiInfoMBS
dim d as PortAudioDeviceInfoMBS
dim i,c as integer
o=me.CellTag(row,0)
if o=nil then
Return
end if
if o isa PortAudioHostApiInfoMBS then
h=PortAudioHostApiInfoMBS(o)
me.AddRow "deviceCount: "+str(h.deviceCount)
me.AddRow "defaultInputDevice: "+str(h.defaultInputDevice)
me.AddRow "defaultOutputDevice: "+str(h.defaultOutputDevice)
me.AddRow "type: "+str(h.type)
c=h.deviceCount-1
for i=0 to c
d=p.DeviceInfo(p.HostApiDeviceIndexToDeviceIndex(h.Index, i))
if d<>Nil then
ListBox1.AddFolder d.name
ListBox1.CellTag(ListBox1.LastIndex,0)=d
end if
next
elseif o isa PortAudioDeviceInfoMBS then
d=PortAudioDeviceInfoMBS(o)
me.AddRow "DefaultLowInputLatency: "+str(d.DefaultLowInputLatency)
me.AddRow "DefaultHighInputLatency: "+str(d.DefaultHighInputLatency)
me.AddRow "DefaultLowOutputLatency: "+str(d.DefaultLowOutputLatency)
me.AddRow "DefaultHighOutputLatency: "+str(d.DefaultHighOutputLatency)
me.AddRow "DefaultSampleRate: "+str(d.DefaultSampleRate)
me.AddRow "HostApiIndex: "+str(d.HostApiIndex)
me.AddRow "maxInputChannels: "+str(d.maxInputChannels)
me.AddRow "maxOutputChannels: "+str(d.maxOutputChannels)
me.AddRow "Index: "+str(d.index)
end if
End EventHandler
End Control
EventHandler Sub Open()
dim i,c as integer
dim host as PortAudioHostApiInfoMBS
p=new PortAudioMBS
ListBox1.AddRow "DefaultHostApiIndexd: "+str(p.DefaultHostApiIndexd)
ListBox1.AddRow "DefaultInputDeviceID: "+str(p.DefaultInputDeviceID)
ListBox1.AddRow "DefaultOutputDeviceID: "+str(p.DefaultOutputDeviceID)
c=p.HostApiCount
ListBox1.AddRow "HostApiCount: "+str(p.HostApiCount)
for i=0 to c
host=p.HostApiInfo(i)
if host<>Nil then
ListBox1.AddFolder host.name
ListBox1.CellTag(ListBox1.LastIndex,0)=host
end if
next
End EventHandler
Property Protected p As PortAudioMBS
End Class
Class StartWindow Inherits Window
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action()
InfoWindow.Show
End EventHandler
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action()
PlayWindow.Show
End EventHandler
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control PushButton4 Inherits PushButton
ControlInstance PushButton4 Inherits PushButton
EventHandler Sub Action()
PlayWindowTimer.Show
End EventHandler
End Control
Control PushButton5 Inherits PushButton
ControlInstance PushButton5 Inherits PushButton
EventHandler Sub Action()
InputLevelWindow.Show
End EventHandler
End Control
Control PushButton6 Inherits PushButton
ControlInstance PushButton6 Inherits PushButton
EventHandler Sub Action()
InputLevelWindowTimer.Show
End EventHandler
End Control
Control PushButton3 Inherits PushButton
ControlInstance PushButton3 Inherits PushButton
EventHandler Sub Action()
PlaybackWindow.Show
End EventHandler
End Control
Control PushButton7 Inherits PushButton
ControlInstance PushButton7 Inherits PushButton
EventHandler Sub Action()
PlayBufferedWindow.Show
End EventHandler
End Control
Control PushButton8 Inherits PushButton
ControlInstance PushButton8 Inherits PushButton
EventHandler Sub Action()
RecorderWindow.init
End EventHandler
End Control
EventHandler Sub Open()
if TargetMacOS THEN
if TargetMachO then
'ok
else
MsgBox "PEF targets are not supported for the PortAudio plugin. Please switch to MachO."
end if
end if
End EventHandler
End Class
Module Util
Function Str(H as PortAudioHosterrorInfoMBS) As string
Return str(h.ErrorCode)+" "+h.ErrorText
End Function
End Module
Class PlayWindowTimer Inherits Window
Control ListBox1 Inherits ListBox
ControlInstance ListBox1 Inherits ListBox
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
#pragma DisableBackgroundTasks
#pragma DisableBoundsChecking
const delta=0.01000
dim FrameCount,n,c,i,e,size as integer
dim f as single
dim m as MemoryBlock
FrameCount=s.WriteAvailable
if FrameCount>0 then
size=FrameCount*8
if lastm=nil or lastm.size<>size then
m = New MemoryBlock(size)
lastm=m
else
m=lastm // reuse
end if
c=FrameCount-1
for i=0 to c
f= 0.25 * sin( timeIndex * 2.0 * 3.1415926 * 920.0 / 48000.0)
timeIndex=timeIndex+1
m.SingleValue(n)=f // left
n=n+4
m.SingleValue(n)=f // right
n=n+4
next
e=s.Write(m,FrameCount)
if e=-9980 then
ListBox1.AddRow "Write: "+str(e)+" = Buffer Underflow"
elseif e<>0 then
ListBox1.AddRow "Write: "+str(e)
end if
end if
End EventHandler
End Control
EventHandler Sub Close()
dim e as integer
if s<>nil then
e=s.Stop
e=s.Close
end if
End EventHandler
EventHandler Sub Open()
run
End EventHandler
Sub run()
const paFloat32 = 1
const paInt32 = 2
const paInt24 = 4
const paInt16 = 8
const paInt8 = 16
const paUInt8 = 32
#if TargetMacOS
const rate = 44100
#else
const rate=48000 // My Linux does not like 8000!
#endif
dim e as integer
p=new PortAudioMBS
s=new PortAudioStreamMBS
e=s.OpenDefaultStream(0,2,paFloat32, rate, 0, 0)
ListBox1.AddRow "OpenDefaultStream: "+str(e)
if e=0 then
e=s.Start
ListBox1.AddRow "Start: "+str(e)
e=s.IsStreamActive
ListBox1.AddRow "Active: "+str(e)
else
// On Linux 8000 is not supported?
ListBox1.AddRow "Host Error: "+str(s.HostError)
end if
End Sub
Property Protected LastM As memoryBlock
Property Protected p As PortAudioMBS
Property Protected s As PortAudioStreamMBS
Property Protected timeIndex As integer
End Class
Class InputLevelWindowTimer Inherits Window
Control ListBox1 Inherits ListBox
ControlInstance ListBox1 Inherits ListBox
End Control
Control OutCanvas Inherits Canvas
ControlInstance OutCanvas Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect)
#Pragma unused areas
If out <> Nil Then
g.DrawPicture out, 0, 0, g.Width, g.Height, 0, 0, out.Width, out.Height
End If
End EventHandler
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
work
End EventHandler
End Control
EventHandler Sub Close()
If sr <> Nil Then
Call sr.stop
End If
End EventHandler
EventHandler Sub Open()
run
End EventHandler
Protected Sub run()
const paFloat32 = 1
const paInt32 = 2
const paInt24 = 4
const paInt16 = 8
const paInt8 = 16
const paUInt8 = 32
const paStereo = 2
const paMono = 1
const paNoDevice=-1
Dim e As Integer
p=new PortAudioMBS
sr=new PortAudioStreamMBS
e=sr.OpenDefaultStream(paMono, 0, paFloat32, 44100,10240,0)
ListBox1.AddRow "OpenStream record: "+str(e)
if e=0 then
e=sr.Start
ListBox1.AddRow "Start record: "+str(e)
e=sr.IsStreamActive
ListBox1.AddRow "Active record: "+str(e)
else
Return
end if
End Sub
Protected Sub work()
dim n,e as integer
dim m as MemoryBlock
dim size as integer
dim i as integer
dim sum,f as Single
dim FrameCount,y,h,w as integer
dim g as Graphics
FrameCount=400
size=FrameCount*4
m = New MemoryBlock(size)
e=sr.Read(m,FrameCount)
if e=0 then
n=0
for i=1 to FrameCount
f=m.SingleValue(n)
if f>0 then
sum=sum+f
else
sum=sum-f
end if
n=n+4
next
If out = Nil Or out.Width <> OutCanvas.Width Or out.Height <> OutCanvas.Height Then
out = New Picture(OutCanvas.Width, OutCanvas.Height, 32)
End If
g = out.Graphics
h = g.Height-1
w = g.Width-1
y=h-sum*h/FrameCount
if y<0 then
y=0
elseif y>h then
y=h
end if
g.ForeColor=&c00FF00
g.DrawLine pos,y-1,pos,y+2
g.ForeColor=&c000000
g.DrawLine pos,0,pos,y
g.ForeColor=&c0000FF
g.DrawLine pos,y,pos,h
pos=pos+1
if pos=w then
pos=0
end if
g.ForeColor=&cFF0000
g.DrawLine pos,0,pos,h
OutCanvas.Invalidate
End If
End Sub
Property Out As Picture
Property Protected p As PortAudioMBS
Property Protected pos As integer
Property Protected sr As PortAudioStreamMBS
End Class
Class PlaybackWindow Inherits Window
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action()
Record
End EventHandler
End Control
Control playbutton Inherits PushButton
ControlInstance playbutton Inherits PushButton
EventHandler Sub Action()
play
End EventHandler
End Control
Control ListBox1 Inherits ListBox
ControlInstance ListBox1 Inherits ListBox
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
if sp<>nil then
if sp.IsStreamActive=1 then
ListBox1.AddRow "Playing..."
end if
end if
if sr<>nil then
if sr.IsStreamActive=1 then
ListBox1.AddRow "Recording... "+str(sr.SpaceLeft)
end if
end if
End EventHandler
End Control
EventHandler Sub Open()
p=new PortAudioMBS
End EventHandler
Sub Record()
const paFloat32 = 1
const paInt32 = 2
const paInt24 = 4
const paInt16 = 8
const paInt8 = 16
const paUInt8 = 32
const paStereo = 2
const paMono = 1
const paNoDevice=-1
channelCount= paMono
dim e as integer
if sp<>nil then
call sp.Abort
sp=nil
end if
samples=10*44100*channelCount // 10 Seconds at 44100 samples per second
size=4*samples // bytes needed
data = New MemoryBlock(size+1024) // buffer a bit bigger
sr=new MyPortAudioRecordStreamMBS
sr.channelCount=channelCount
sr.data=data
sr.size=size
sr.SpaceLeft=samples
sr.offset=0
sr.UseSafeThreading=false
e=sr.OpenDefaultStream(channelCount, 0, paFloat32, 44100,0,0)
ListBox1.AddRow "OpenStream record: "+str(e)
if e=0 then
e=sr.Start
ListBox1.AddRow "Start record: "+str(e)
e=sr.IsStreamActive
ListBox1.AddRow "Active record: "+str(e)
else
Return
end if
playbutton.enabled=True
End Sub
Sub play()
const paFloat32 = 1
const paInt32 = 2
const paInt24 = 4
const paInt16 = 8
const paInt8 = 16
const paUInt8 = 32
const paNoDevice=-1
dim e as integer
if sr<>nil then // stop recording
call sr.Abort
sr=nil
end if
sp=new MyPortAudioPlaybackStreamMBS
sp.data=data
sp.channelCount=channelCount
sp.SampleCount=samples
sp.UseSafeThreading=false
e=sp.OpenDefaultStream(0,channelCount, paFloat32, 44100,0,0)
ListBox1.AddRow "OpenStream playback: "+str(e)
if e=0 then
e=sp.Start
ListBox1.AddRow "Start playback: "+str(e)
e=sp.IsStreamActive
ListBox1.AddRow "Active playback: "+str(e)
else
Return
end if
End Sub
Property channelCount As Integer = 1
Property data As memoryBlock
Property p As portaudiombs
Property samples As integer
Property size As integer
Property sp As MyPortAudioPlaybackStreamMBS
Property sr As MyPortAudioRecordStreamMBS
End Class
Class MyPortAudioInputLevelStreamMBS Inherits PortAudioStreamMBS
EventHandler Function Callback(InputBuffer as memoryblock, outputBuffer as memoryblock, FrameCount as integer, inputBufferAdcTime as double, currentTime as double, outputBufferDacTime as double, statusFlags as integer) As integer
Dim n As Integer
dim m as MemoryBlock
dim size as integer
dim i as integer
dim sum,f as Single
dim y,h,w as integer
if g<>nil then
size=FrameCount*4
m=InputBuffer
n=0
for i=1 to FrameCount
f=m.SingleValue(n)
if f>0 then
sum=sum+f
else
sum=sum-f
end if
n=n+4
next
h=g.Height-1
w=g.Width-1
y=h-sum*h/FrameCount
if y<0 then
y=0
elseif y>h then
y=h
end if
g.ForeColor=&c00FF00
g.DrawLine pos,y-1,pos,y+2
g.ForeColor=&c000000
g.DrawLine pos,0,pos,y
g.ForeColor=&c0000FF
g.DrawLine pos,y,pos,h
pos=pos+1
if pos=w then
pos=0
end if
g.ForeColor=&cFF0000
g.DrawLine pos,0,pos,h
OutCanvas.Invalidate
End If
End EventHandler
Property OutCanvas As Canvas
Property g As graphics
Property pos As integer
End Class
Class InputLevelWindow Inherits Window
Control ListBox1 Inherits ListBox
ControlInstance ListBox1 Inherits ListBox
End Control
Control OutCanvas Inherits Canvas
ControlInstance OutCanvas Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect)
#Pragma unused areas
If out <> Nil Then
g.DrawPicture out, 0, 0, g.Width, g.Height, 0, 0, out.Width, out.Height
End If
End EventHandler
End Control
EventHandler Sub Close()
If sr <> Nil Then
Call sr.stop
End If
End EventHandler
EventHandler Sub Open()
run
End EventHandler
Protected Sub run()
const paFloat32 = 1
const paInt32 = 2
const paInt24 = 4
const paInt16 = 8
const paInt8 = 16
const paUInt8 = 32
const paStereo = 2
const paMono = 1
const paNoDevice=-1
Dim e As Integer
p=new PortAudioMBS
sr=new MyPortAudioInputLevelStreamMBS
e=sr.OpenDefaultStream(paMono, 0, paFloat32, 44100,0,0)
ListBox1.AddRow "OpenStream record: "+str(e)
if e=0 then
e=sr.Start
ListBox1.AddRow "Start record: "+str(e)
e=sr.IsStreamActive
ListBox1.AddRow "Active record: "+str(e)
else
Return
end if
out = New Picture(OutCanvas.Width, OutCanvas.Height, 32)
sr.OutCanvas = self.OutCanvas
sr.g = Out.Graphics
End Sub
Protected Sub work()
End Sub
Property Out As Picture
Property Protected p As PortAudioMBS
Property Protected pos As integer
Property Protected sr As MyPortAudioInputLevelStreamMBS
End Class
Class PlayWindow Inherits Window
Control ListBox1 Inherits Listbox
ControlInstance ListBox1 Inherits Listbox
End Control
EventHandler Sub Close()
dim e as integer
if s<>nil then
e=s.Stop
e=s.Close
end if
End EventHandler
EventHandler Sub Open()
run
End EventHandler
Sub run()
const paFloat32 = 1
const paInt32 = 2
const paInt24 = 4
const paInt16 = 8
const paInt8 = 16
const paUInt8 = 32
const rate=48000 // My Linux does not like 8000!
dim e as integer
p=new PortAudioMBS
s=new MyPortAudioGenerateStreamMBS
e=s.OpenDefaultStream(0,2,paFloat32, rate, 0, 0)
ListBox1.AddRow "OpenDefaultStream: "+str(e)
if e=0 then
e=s.Start
ListBox1.AddRow "Start: "+str(e)
e=s.IsStreamActive
ListBox1.AddRow "Active: "+str(e)
s.UseSafeThreading=false
else
// On Linux 8000 is not supported?
ListBox1.AddRow "Host Error: "+str(s.HostError)
end if
End Sub
Property Protected p As PortAudioMBS
Property Protected s As PortAudioStreamMBS
End Class
Class MyPortAudioGenerateStreamMBS Inherits PortAudioStreamMBS
EventHandler Function Callback(InputBuffer as memoryblock, outputBuffer as memoryblock, FrameCount as integer, inputBufferAdcTime as double, currentTime as double, outputBufferDacTime as double, statusFlags as integer) As integer
#pragma StackOverflowChecking false
#pragma DisableBackgroundTasks
#pragma DisableBoundsChecking
const delta=0.01000
dim n,c,i as integer
dim f as single
System.DebugLog str(FrameCount)+" frames"
c=FrameCount-1
for i=0 to c
f= 0.25 * sin( timeIndex * 2.0 * 3.1415926 * 920.0 / 48000.0)
timeIndex=timeIndex+1
outputBuffer.SingleValue(n)=f // left
n=n+4
outputBuffer.SingleValue(n)=f // right
n=n+4
next
End EventHandler
Property Protected leftphase As single
Property Protected rightphase As single
Property Protected timeIndex As integer
End Class
Class MyPortAudioRecordStreamMBS Inherits PortAudioStreamMBS
EventHandler Function Callback(InputBuffer as memoryblock, outputBuffer as memoryblock, FrameCount as integer, inputBufferAdcTime as double, currentTime as double, outputBufferDacTime as double, statusFlags as integer) As integer
#pragma DisableBackgroundTasks
#pragma DisableBoundsChecking
#pragma StackOverflowChecking false
// Using unsafe threading requires all the pragmas above and
// you are now allowed to call a function
// not even object locking, so no strings!
const paComplete=1
const paContinue=0
dim n,i,o as integer
dim f as Single
FrameCount=FrameCount*channelCount // mono or stereo?
o=0
n=SpaceLeft
if n>FrameCount then
n=FrameCount
end if
for i=1 to n
f=InputBuffer.SingleValue(o)
o=o+4
data.SingleValue(offset)=f
offset=offset+4
SpaceLeft=SpaceLeft-1
next
if SpaceLeft<=0 then
call me.Abort
Return paComplete
else
Return paContinue
end if
End EventHandler
Property SpaceLeft As integer
Property channelCount As Integer
Property data As memoryBlock
Property offset As integer
Property size As integer
End Class
Class MyPortAudioPlaybackStreamMBS Inherits PortAudioStreamMBS
EventHandler Function Callback(InputBuffer as memoryblock, outputBuffer as memoryblock, FrameCount as integer, inputBufferAdcTime as double, currentTime as double, outputBufferDacTime as double, statusFlags as integer) As integer
#pragma DisableBackgroundTasks
#pragma DisableBoundsChecking
#pragma StackOverflowChecking false
// Using unsafe threading requires all the pragmas above and
// you are now allowed to call a function
// not even object locking, so no strings!
const paComplete=1
const paContinue=0
dim n,i,o as integer
dim f as Single
FrameCount=FrameCount*channelCount // mono or stereo?
n=FrameCount
if n>SampleCount then
n=SampleCount
end if
o=0
for i=1 to n
f=data.SingleValue(Offset)
Offset=Offset+4
SampleCount=SampleCount-1
outputBuffer.SingleValue(o)=f
o=o+4
next
if SampleCount<1 then
Return paComplete
else
Return paContinue
end if
End EventHandler
Property Offset As integer
Property SampleCount As integer
Property channelCount As Integer
Property data As memoryBlock
End Class
Class PlayBufferedWindow Inherits Window
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action()
dim timeIndex,totaltime,n,p as integer
dim rate as Single
dim f as single
dim audioBuffer as MemoryBlock
dim c as PortAudioStreamBufferedMBS
dim lastp as integer
dim e as integer
dim started as Boolean
timeIndex = 0
rate = 8000.0
totalTime = rate * 10 // 10 seconds
f = 440.0
po=new PortAudioMBS
c = new PortAudioStreamBufferedMBS
dim pasp as new PortAudioStreamParametersMBS
pasp.ChannelCount = 1
pasp.Device = po.DefaultOutputDeviceID
pasp.SampleFormat = 1
pasp.SuggestedLatency = 0.2
// e = c.OpenDefaultStream(1,rate)
e = c.OpenStream(pasp,rate,0,0)
ListBox1.AddRow "OpenDefaultStream: "+str(e)
system.DebugLog "OpenDefaultStream: "+str(e)
if e=0 then
else
// On Linux 8000 is not supported?
ListBox1.AddRow "Host Error: "+str(c.HostError)
Return
end if
const BUFSIZE=4000
started=false
audioBuffer = New MemoryBlock(BUFSIZE*4)
while (timeIndex < totalTime) or c.IsStreamActive=1
// Output sound until our ten seconds are up
p=300.0*c.OutputPosition/totaltime
if p<>lastp then
lastp=p
ProgressBar1.Value=p
ProgressBar1.Refresh
// System.DebugLog "Last percent: "+str(p)
end if
if (timeIndex < totalTime) and (c.FreeSpace>0) then
p=0
for n = 1 to BUFSIZE
audioBuffer.SingleValue(p) = 0.25 * sin(timeIndex * 2.0 * 3.1415926 * f / rate)
p=p+4
timeIndex=timeIndex+1
next
if not c.AddFloatAudio(audioBuffer) then
MsgBox "Failed to play audio!"
Return
else
System.DebugLog "AddFloatAudio ok"
if not started then
started=true
e=c.Start
System.DebugLog "Start: "+str(e)
ListBox1.AddRow "Start: "+str(e)
e=c.IsStreamActive
System.DebugLog "Active: "+str(e)
ListBox1.AddRow "Active: "+str(e)
end if
end if
end if
wend
while c.IsStreamActive=1
app.DoEvents
wend
End EventHandler
End Control
Control ProgressBar1 Inherits ProgressBar
ControlInstance ProgressBar1 Inherits ProgressBar
End Control
Control ListBox1 Inherits ListBox
ControlInstance ListBox1 Inherits ListBox
End Control
Property po As PortAudioMBS
End Class
Class RecorderWindow Inherits Window
Const Frequency = 8000
Control outCanvas Inherits Canvas
ControlInstance outCanvas Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect)
#pragma unused areas
If out <> Nil Then
g.DrawPicture out, 0, 0, g.Width, g.Height, 0, 0, out.Width, out.Height
End If
End EventHandler
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
dim l as integer
// we ask for samples in the buffer
l=p.ReadFrames(m, m.Size)
if l>0 then
// process the l frames we got
ProcessFrames m, l
if SaveToFile then
AddMemory M, l
end if
end if
End EventHandler
End Control
EventHandler Sub Close()
Timer1.Mode = 0
if SaveToFile then
save
end if
End EventHandler
Sub AddMemory(m as MemoryBlock, samples as integer)
dim p,q,c,i as integer
dim x as MemoryBlock
x = New MemoryBlock(samples*2)
x.LittleEndian=true
p=0
q=0
c=samples-1
for i=0 to c
x.Short(q)=m.SingleValue(p)*32767.0
p=p+4
q=q+2
next
data.Append x
End Sub
Sub ProcessFrames(m as MemoryBlock, l as integer)
dim b as Double
dim c as integer = l-1
dim mi,ma as Double
// just find min and max and display it here
b=m.SingleValue(0)
ma=b
mi=b
for i as integer=0 to c
b=m.SingleValue(4*i)
if b>ma then
ma=b
end if
if b<mi then
mi=b
end if
next
// scale so we see more
ma=ma*2
mi=mi*2
ma = abs(ma)
mi = abs(mi)
// draw to the screen directly
Dim w As Integer = OutCanvas.width
Dim h As Integer = OutCanvas.Height
Dim h2 As Integer = h/2
If out = Nil Or out.Width <> w Or out.Height <> h Then
out = New Picture(w, h, 32)
End If
dim g as Graphics = out.Graphics
g.ForeColor=&cFFFFFF
g.DrawLine index, 0, index, h
g.ForeColor=&cFF0000
g.DrawLine index, h2, index, h2-ma*h2
g.ForeColor=&c00FF00
g.DrawLine index, h2, index, h2+mi*h2
OutCanvas.Invalidate
// move to the next line
index=index+1
if index=w then
index=0
end if
End Sub
Shared Sub init()
Dim d as New MessageDialog //declare the MessageDialog object
Dim b as MessageDialogButton //for handling the result
d.icon=MessageDialog.GraphicCaution //display warning icon
d.ActionButton.Caption="Save"
d.CancelButton.Visible=True //show the Cancel button
d.AlternateActionButton.Visible=True //show the “Don’t Save” button
d.AlternateActionButton.Caption="Don’t Save"
d.Message="Do you want to save the recording when you close the window?"
b=d.ShowModal //display the dialog
Select Case b //determine which button was pressed.
Case d.ActionButton
RecorderWindow.initialize true
Case d.AlternateActionButton
RecorderWindow.initialize false
//user pressed Don’t Save
Case d.CancelButton
Return
//user pressed Cancel
End select
End Sub
Sub initialize(b as Boolean)
SaveToFile=b
m = New MemoryBlock(4*10240) // read 10240 samples per timer loop
p=new PortAudioStreamRecorderMBS(1024*1024)
if p.OpenDefaultStream(1, Frequency)=0 then
if p.Start=0 then
timer1.Mode=timer1.ModeMultiple
else
MsgBox "Failed to start."
end if
else
MsgBox "Failed to initialize."
end if
End Sub
Sub save()
// save as WAV
// for more options, please use SoundFileMBS class
dim size as integer=0
Dim f As FolderItem = GetSaveFolderItem(FileTypes1.AudioWav,"audio.wav")
If f <> Nil Then
Dim b As BinaryStream = f.CreateBinaryFile(FileTypes1.AudioWav)
if b = nil then
MsgBox "Failed to create file " + f.NativePath
else
for each m as MemoryBlock in data
size = size + m.size
next
b.LittleEndian=true
b.Write "RIFF"
b.WriteInt32 6+4+16+4+Size // size of file
b.Write "WAVE"
b.Write "fmt "
b.WriteInt32 16 // size of following data
b.WriteInt16 1 // format, uncompressed
b.WriteInt16 1 // 1 Channel
b.WriteInt32 Frequency // Samples per Second
b.WriteInt32 Frequency*2 // Bytes per Second
b.WriteInt16 2 // Block align, Size of Sample in Bytes
b.WriteInt16 16 // bits per sample
b.Write "data"
b.WriteInt32 Size
for each m in data
b.Write m
next
b.Close
end if
end if
End Sub
Note "Frequency"
you can set frequency to 8000 for phone quality or for example to 44100 for HiFi
Property Out As Picture
Property Protected SaveToFile As Boolean
Property Protected data() As MemoryBlock
Property index As Integer
Property m As MemoryBlock
Property p As PortAudioStreamRecorderMBS
End Class
FileTypes1
Filetype audio/wav
End FileTypes1
ExternalFile info
End ExternalFile
End Project
See also:
The items on this page are in the following plugins: MBS Audio Plugin.
