Here is a demo program for recording audio using PortAudio. You will need a dll and a lib file to compile it (or the OS X/Linux equivalents) as well as PortAudio.pb found elsewhere in this thread.
This is a cut down version of a more functional recording program. It still has some rough edges. Code for metering and timing the length of the recording have been eliminated so that you can have the fun of writing them yourself. It does demonstrate some techniques any PortAudio program should use, such as:
- Multi-threading -- There is a separate thread for writing data to disk which runs separately from the PortAudio callback. This is very important because you don't want system tasks such as disk writing to block the callback (important in real-time programming). If you implement an audio level meter you will want to encapsulate that in a separate thread for the same reason.
- File buffering -- uses FileBuffersSize() to force disk buffering of the audio buffer so that WriteData() does not return until disk write is finished, making writeFlag a valid indicator of disk activity.
- Ring buffering -- This is not a necessity but is a feature I added to test the PB ring buffer written by infratec. At present it starts recording when you launch the program rather than when you press the record button, but you can fix that. Ring buffers are commonly used in this type of program, but my preferred method of buffering is dynamic and adjusts the buffer size according to the amount of data present. In recording you never want an overflow, i.e. the data arrives faster than it can be written to a storage medium (one alternative would be to allocate a huge RAM buffer -- around 2 GB -- and write the data to hard disk when the recording is stopped).
Code: Select all
;PA RINGBUFFER DEMO.PB
;USES RING BUFFER
;WORKS WITH PUREBASIC 5.00
;UPDATED BY CHRIS319 ON 2/3/2013
;RingBuffer implementation by infratec
;CUT-DOWN VERSION FOR POSTING ON PB FORUM
;STRUCTURE MEMBER ALIGNMENT MUST BE 4 BYTES WHEN COMPILING DLL
XIncludeFile "PortAudio.pb"
Enumeration
#RingBuffer_Getmode
#RingBuffer_Peekmode
EndEnumeration
Structure RingBufferStructure
*RingBuffer
Size.i
ReadPtr.i
WritePtr.i
EndStructure
;With the optional parameter Mode = #RingBuffer_Peekmode of RingBuffer_Get(),
;you can get Data without removing them from the buffer.
Global RB1.RingBufferStructure
Procedure.i RingBufferInit(*RB.RingBufferStructure, Size)
*RB\RingBuffer = AllocateMemory(Size)
If *RB\RingBuffer <> 0
*RB\Size = Size
*RB\ReadPtr = 0
*RB\WritePtr = 0
Else
*RB\Size = 0
EndIf
ProcedureReturn *RB\Size
EndProcedure
Procedure.i RingBufferBytesToRead(*RB.RingBufferStructure)
Protected Result.i
If *RB\WritePtr = *RB\ReadPtr
Result = 0
ElseIf *RB\WritePtr > *RB\ReadPtr
Result = *RB\WritePtr - *RB\ReadPtr
Else
Result = *RB\Size - (*RB\ReadPtr - *RB\WritePtr)
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i RingBufferPut(*RB.RingBufferStructure, *Src, Bytes)
Protected Result.i, Extra.i
;Result = #False
If *RB\Size - RingBufferBytesToRead(*RB.RingBufferStructure) >= Bytes
If *RB\WritePtr + Bytes <= *RB\Size
CopyMemory(*Src, *RB\RingBuffer + *RB\WritePtr, Bytes)
*RB\WritePtr + Bytes
Else
Extra = *RB\Size - *RB\WritePtr
CopyMemory(*Src, *RB\RingBuffer + *RB\WritePtr, Extra)
CopyMemory(*Src + Extra, *RB\RingBuffer, Bytes - Extra)
*RB\WritePtr = Bytes - Extra
EndIf
Result = #True
Else
Result = #False
EndIf
ProcedureReturn Result
EndProcedure
; Procedure.i RingBufferGet(*RB.RingBufferStructure, *Dst, Bytes.i, Mode.i = #RingBuffer_Getmode)
Procedure.i RingBufferGet(*RB.RingBufferStructure, *Dst, Bytes.i)
Protected AvailableBytes.i, Part.i
AvailableBytes = RingBufferBytesToRead(*RB.RingBufferStructure)
If AvailableBytes > 0
If AvailableBytes < Bytes : Bytes = AvailableBytes : EndIf
If *RB\Size - *RB\ReadPtr >= Bytes
CopyMemory(*RB\RingBuffer + *RB\ReadPtr, *Dst, Bytes)
; If Mode = #RingBuffer_Getmode :
*RB\ReadPtr + Bytes
; : EndIf
Else
Part = *RB\Size - *RB\ReadPtr
CopyMemory(*RB\RingBuffer + *RB\ReadPtr, *Dst, Part)
CopyMemory(*RB\RingBuffer, *Dst + Part, Bytes - Part)
; If Mode = #RingBuffer_Getmode :
*RB\ReadPtr = Bytes - Part
; : EndIf
EndIf
Else
Bytes = 0
EndIf
ProcedureReturn Bytes
EndProcedure
Procedure RingBufferClear(*RB.RingBufferStructure)
*RB\ReadPtr = 0
*RB\WritePtr = 0
EndProcedure
Procedure RingBufferFree(*RB.RingBufferStructure)
FreeMemory(*RB\RingBuffer)
*RB\Size = 0
*RB\ReadPtr = 0
*RB\WritePtr = 0
EndProcedure
CompilerIf(#PB_Compiler_OS = #PB_OS_Windows)
Global WasapiInfo.PaWasapiStreamInfo
WasapiInfo\size = SizeOf(PaWasapiStreamInfo)
WasapiInfo\hostApiType = #paWASAPI
WasapiInfo\version = 1
WasapiInfo\flags = #paWinWasapiExclusive | #paWinWasapiPolling
WasapiInfo\channelMask = #Null
WasapiInfo\hostProcessorOutput = #Null
WasapiInfo\hostProcessorInput = #Null
WasapiInfo\threadPriority = #Null
;Global WasapiPlaybackInfo.PaWasapiStreamInfo ;FOR OUTPUT DEVICE IN NON-EXCLUSIVE MODE
;WasapiPlaybackInfo\size = SizeOf(PaWasapiStreamInfo)
;WasapiPlaybackInfo\hostApiType = #paWASAPI
;WasapiPlaybackInfo\version = 1
;WasapiPlaybackInfo\flags = #Null ;NO EXCLUSIVE MODE FOR OUTPUT DEVICE!
;WasapiPlaybackInfo\channelMask = #Null
;WasapiPlaybackInfo\hostProcessorOutput = #Null
;WasapiPlaybackInfo\hostProcessorInput = #Null
;WasapiPlaybackInfo\threadPriority = #Null
CompilerEndIf
Global bct ;FOR TESTING RING BUFFER
Global *bigBufferSize, *bufLimit, slash$, recBoxFlag = #False
Global maxBytes.q ;= (2 * 1024 * 1024 * 1024) - (*bigBufferSize * 2) ;2147483648 -- 2 GB MAXIMUM FILE SIZE
;Global maxBytes.q = 1 * 1024 * 1024 * 1024 ; 1 GB MAXIMUM FILE SIZE
;Global maxBytes.q = 100 * 8192 ;FOR TESTING
#MENU_MARGIN = 22: #TEXT_Y = 380
#STOP_RED = $333377: #BRIGHT_RED = $3333ff
#LEFT_EDGE = 50
#RECBOX_X = 20: #RECBOX_Y = 5: #RECBOX_WIDTH = 97: #RECBOX_HEIGHT = 75
#BUFFER_DURATION = 30 * 1000;ms 30 SECONDS
;#BUFFER_DURATION = 125 ;ms
Global NO_DRAG_Y
#TIMER_CONFIRM_HEIGHT = 90 ;HEIGHT OF TIMER AND CONFIRM TEXT GADGETS
#BG_COLOR = $eeeeee
#BUTTON_WIDTH = 60
Global center, bytesToWrite, quantity, audioSemaphore, fileBufferSize
Global firstPass, stopFlag, quitFlag, file_name$, *startToWrite
Global *buffer1, *dealloc1, *buffer2, *dealloc2 ;, *monitorBuffer
Global writeFlag, recordedBytes, audioLoopContinue
Global *null = 0
Global Dim *Devices.PaDeviceInfo(0)
Global Dim *Devices(0)
Structure SAllocation
Size.i
File.s
Line.i
Pointer.i
EndStructure
Global NewList Memories.SAllocation() ;FOR DETECTING MEMORY LEAKS
Procedure _AllocateMemory3(Size, File.s, Line.i)
AddElement(Memories())
Memories()\Size = Size
Memories()\File = File
Memories()\Line = Line
Memories()\Pointer = AllocateMemory(Size)
ProcedureReturn Memories()\Pointer
EndProcedure
Macro AllocateMemory3(Size)
_AllocateMemory3(Size, #PB_Compiler_File, #PB_Compiler_Line)
EndMacro
Procedure FreeMemory3(Memory)
ForEach Memories()
If Memories()\Pointer = Memory
DeleteElement(Memories())
Break
EndIf
Next
If Memory <> #Null: FreeMemory(Memory): EndIf
EndProcedure
;ShowVariableViewer()
Global framesPerBuffer
Global sampleRate.d, secns
Global byteCount, inputbox, outputbox
Global source_device, dest_device, filehandle1, bytesRecorded
Global in_streamparms.PaStreamParameters, out_streamparms.PaStreamParameters
Global *my_Stream, *my_Stream2, *my_Stream3, file_length, offset.q, writeAudioFlag, overflowCount
Global Dim device$(255)
Global scale.f, sample.w, float_sample.f, min.f, bar_height.l, buf_addr.l
Global window_height.l, bar_y.l, rec_end.l, fullscale.w, File.s
Global chunksize.l, subchunk1ID.l, subchunk1Size.l, audioformat.w, cutCounter
Global byterate.l, blockalign.u, bitsPerSample.u, subchunk2size.l, ct.l, tempword.w
Global servct = 0, QuitRec.l, program_running.l
Global scale.f, sample.w, float_sample.f, min.f, bar_height.l, buf_addr.l, frameCount, bytesPerFrame
Global window_width.l, window_height.l, bar_y.l, rec_end.l, fullscale.w
Global subchunk1id.l, audioformat.w, buffersize, record_minutes.f, avail_mem.q
Global ct.l, stream_open, record_seconds.l
Global elapsed_seconds.l, remaining_seconds.l, recording_now, ch2Offset
Global hours.s, minutes.s, seconds.s, DeviceName.s
Global draw_bkgd.l, leftY, rightY, device_offset, deviceCount, totalBytes.q
Global format, sampleformat, threadID1, killThread1 = #False
Global channels.u, bitDepth.u, SampleRate.d
Structure MYWAVEFORMATEX
wFormatTag.u
nChannels.u
nSamplesPerSec.l
nAvgBytesPerSec.l
nBlockAlign.u
wBitsPerSample.u
cbSize.u
EndStructure
Structure WAVEFORMATEXTENSIBLE
format.MYWAVEFORMATEX ;WAVEFORMATEX STRUCTURE
StructureUnion
wValidBitsPerSample.u
wSamplesPerBlock.u
wReserved.u
EndStructureUnion
dwChannelMask.l
CompilerIf(#PB_Compiler_OS = #PB_OS_Windows)
SubFormat.GUID
CompilerElse
SubFormat.s{16}
CompilerEndIf
EndStructure
Global my_WFE.WAVEFORMATEXTENSIBLE
;Global *my_HOSTERROR.PaHostErrorInfo
#WAVE_FORMAT_PCM = $0001 ;PCM <= 2 CHANNELS
#WAVE_FORMAT_EXTENSIBLE = $FFFE ;PCM > 2 CHANNELS
#MONO = 1
#STEREO = 2
Enumeration 0 ;_AUDCLNT_SHAREMODE
#AUDCLNT_SHAREMODE_SHARED
#AUDCLNT_SHAREMODE_EXCLUSIVE
EndEnumeration
Enumeration 0 ;GADGETS
#gadStart
#gadStop
#gadChannels
#gadBitDepth
#gadSampleRate
#gadDevice
#gadRecord
; #gadSave
#gadOK
#gadSettings
#gadCutCounter
#gadNextCut
#gadExit
#gadText1 ;CHANNELS
#gadText2 ;BIT DEPTH
#gadText3 ;SAMPLE RATE
#gadText4 ;INPUT DEVICE
#gadText6 ;RECORDING TOO LONG
#gadText7 ;BUFFER OVERFLOW
#gadText8 ;FILE NAME
#gadtoRecord
#gadtoStop
#gadtoExit
#gadRecording ;MESSAGE THAT WE ARE RECORDING NOW
#gadEndOfFile ;NO MORE RECORDING SPACE
#gadConfirm
#gadNextCutText
EndEnumeration
;==============================================================================
Procedure.s Pa_PaHostApiIndexToString(Ind)
*info.PaHostApiInfo = Pa_GetHostApiInfo(Ind)
ProcedureReturn PeekS(*info\name)
EndProcedure
Procedure.s DeviceString(*dev.PaDeviceInfo)
ProcedureReturn PeekS(*dev\name) + " " + Pa_PaHostApiIndexToString(*dev\hostApi)
EndProcedure
Procedure RecBox(boxColor)
Box(#RECBOX_X, #RECBOX_Y, #RECBOX_WIDTH, #RECBOX_HEIGHT - 61, boxColor)
Box(#RECBOX_X, #RECBOX_Y + 55, #RECBOX_WIDTH, #RECBOX_HEIGHT - 61, boxColor)
Box(#RECBOX_X, #RECBOX_Y + 14, #RECBOX_WIDTH - 78, #RECBOX_HEIGHT - 34, boxColor)
Box(#RECBOX_X + 80, #RECBOX_Y + 14, #RECBOX_WIDTH - 80, #RECBOX_HEIGHT - 34, boxColor)
EndProcedure
Procedure Record_Stop()
If recording_now = #True
;While writeFlag = #False: Wend ;IS THE DISK DRIVE BUSY?
; SignalSemaphore(audioSemaphore) ;DATA-WRITE SEMAPHORE
recording_now = #False
Repeat: Until offset = 0; WRITE LAST BIT OF AUDIO
SetGadgetText(#gadRecording, "")
cutCounter + 1: SetGadgetState(#gadCutCounter, cutCounter)
recBoxFlag = #STOP_RED
StickyWindow(1, #False)
DisableGadget(#gadRecord, 0)
DisableGadget(#gadStop, 1)
CloseFile(1)
OpenFile(1, file_name$)
subchunk2size.l = totalBytes.q
FileSeek(1, 4): WriteLong(1, chunksize + subchunk2size) ;WRITE CHUNKSIZE
If my_wfe\format\wFormatTag = #WAVE_FORMAT_EXTENSIBLE
FileSeek(1, 64): WriteLong(1, subchunk2size) ;WRITE SUBCHUNK2SIZE
Else
FileSeek(1, 42): WriteLong(1, subchunk2size) ;WRITE SUBCHUNK2SIZE
EndIf
CloseFile(1)
EndIf
EndProcedure
Procedure ShutDown()
If recording_now = #True: Record_Stop(): EndIf
audioLoopContinue = #False: Delay(250)
Pa_StopStream(*my_stream): Pa_CloseStream(*my_stream)
Pa_Terminate()
killThread1 = #True: SignalSemaphore(audioSemaphore)
FreeMemory3(*dealloc1): FreeMemory3(*dealloc2)
RingBufferFree(@RB1)
StopDrawing()
CloseWindow(1)
End
EndProcedure
Procedure GetDevices()
;;;IMPORTED CODE
Dim channel$(100)
;Global Dim *Devices.PaDeviceInfo(0)
;deviceCount.i
;DefaultOutputIndex.i
;DefaultInputIndex.i
;Enumerate devices ;THIS CODE HAS BEEN MOVED TO GetSettings()
;If deviceCount = 0
; MessageRequester("Error", "No recording devices found.")
; End ;shutdown()
;EndIf
;deviceCount = Pa_GetDeviceCount()
;Global Dim *Devices(deviceCount)
Global Dim api_source$(deviceCount) ;INPUT
Global Dim api_dest$(deviceCount) ;OUTPUT
For I = 0 To deviceCount - 1
*Devices(I) = Pa_GetDeviceInfo(I)
Next
K = 0 ;GET INPUT DEVICE
For I = 0 To deviceCount - 1
If *Devices(I)\maxInputChannels > 0
;device$(I) = PeekS(*Devices(I)\name)
device$(I) = DeviceString(*Devices(I))
channel$(I) = Str(*Devices(I)\maxInputChannels)
ct2 = Len(device$(I))
While Mid(device$(I), ct2, 1) <> " "
ct2 - 1
Wend
api_source$(I) = Right(device$(I), Len(Device$(I)) - ct2)
If source_device = 0: source_device = I: EndIf ;SET TO FIRST-DISCOVERED DEVICE
AddGadgetItem(#gadDevice, -1, device$(I) + " | " + channel$(I) + " channels")
SetGadgetItemData(#gadDevice, K, I)
K + 1
EndIf
Next
; If device$(0) = ""
; MessageRequester("Error", "No recording devices found.")
; shutdown()
; EndIf
EndProcedure
ProcedureC PaStreamCallback(*recordBuffer, *null, frameCount.l, *timeInfo.PaStreamCallbackTimeInfo, statusFlags, *userdata)
recordedBytes = frameCount * bytesPerFrame
RingBufferPut(@RB1, *recordBuffer, recordedBytes)
; ;For TESTING RING BUFFER -- SIMULATES DISK DRIVE BEING BUSY
; Debug bct
; If bct < 4
; bct + 1: blaFlag = #True
; Else
; bct = 0: blaFlag = #False
; EndIf
; If blaFlag = #False ;FOR TESTING RING BUFFER
;bytesToWrite = recordedBytes ;quantity: *startToWrite = *buffer1 + offset
If writeFlag = #False ;IS THE DISK DRIVE BUSY?
SignalSemaphore(audioSemaphore) ;DATA-WRITE SEMAPHORE
; quantity = 0
EndIf
ProcedureReturn #paContinue
EndProcedure
Procedure StreamStart()
result = Pa_IsFormatSupported(@in_streamparms, 0, sampleRate)
If result <> #paFormatIsSupported
*err = Pa_GetErrorText(result): error.string = @*err
CompilerIf(#PB_Compiler_OS = #PB_OS_Windows)
MessageRequester("Source format not supported", error\s+"."+Chr(10)+"Make sure device is in exclusive mode.")
CompilerElse
MessageRequester("Source format not supported", error\s)
CompilerEndIf
shutdown()
EndIf
result = Pa_OpenStream(@*my_stream, @in_streamparms, 0, sampleRate, framesPerBuffer, #paDitherOff|#paClipOff, @PaStreamCallback(), @in_streamparms\hostApiSpecificStreamInfo)
If result <> #paNoError
*err = Pa_GetErrorText(result): error.string = @*err
MessageRequester("Unable to open input stream", error\s)
shutdown()
EndIf
result = Pa_StartStream(*my_stream)
If result <> #paNoError
*err = Pa_GetErrorText(result): error.string = @*err
MessageRequester("Unable to start input stream", error\s)
shutdown()
EndIf
EndProcedure
Procedure GetSettings()
active = Pa_IsStreamActive(*my_stream)
If active = #True
Pa_StopStream(*my_stream)
Pa_CloseStream(*my_stream)
EndIf
;FIND OUT IF THERE ARE ANY RECORDING DEVICES
deviceCount = Pa_GetDeviceCount()
If deviceCount = 0
MessageRequester("Error", "No audio devices found."): Pa_Terminate(): End
EndIf
ReDim *Devices(deviceCount)
For I = 0 To deviceCount - 1
*Devices(I) = Pa_GetDeviceInfo(I)
Next
availableRecordDevices = #Null
For I = 0 To deviceCount - 1
If *Devices(I)\maxInputChannels > 0
availableRecordDevices = #True
EndIf
Next
If availableRecordDevices = #Null
MessageRequester("Error", "No recording devices found."): Pa_Terminate(): End
EndIf
OpenWindow(2, 190, 350, 620, 260, "Control Panel", #PB_Window_SystemMenu)
SetWindowColor(2, #BG_COLOR)
ComboBoxGadget(#gadChannels, 20, 50, 85, 20)
ComboBoxGadget(#gadBitDepth, 115, 50, 90, 20)
ComboBoxGadget(#gadSampleRate, 215, 50, 110, 20)
ComboBoxGadget(#gadDevice, 20, 110, 500, 20)
getDevices()
ButtonGadget(#gadOK, (WindowWidth(2) / 2) - 30, 215, 60, 30, "OK", #PB_Button_Default)
AddKeyboardShortcut(2, #PB_Shortcut_Return, 1) ;ENTER TO ACCEPT SETTINGS
TextGadget(#gadText1, 34, 25,85,20, "Channels")
TextGadget(#gadText2, 131, 25,85,20, "Bit Depth")
TextGadget(#gadText3, 230, 25,85,20, "Sample Rate")
TextGadget(#gadText4, 250, 85, 85,20, "Input Device")
SetGadgetColor(#gadText1, #PB_Gadget_BackColor, #BG_COLOR)
SetGadgetColor(#gadText2, #PB_Gadget_BackColor, #BG_COLOR)
SetGadgetColor(#gadText3, #PB_Gadget_BackColor, #BG_COLOR)
SetGadgetColor(#gadText4, #PB_Gadget_BackColor, #BG_COLOR)
result = OpenPreferences("." + slash$ + "PA Recorder.ini")
If result = #False
MessageRequester("Warning", "Unable to read preferences file.")
EndIf
temp.l = ReadPreferenceLong("channels", 2)
channels = temp
temp.l = ReadPreferenceLong("bitdepth", 24)
bitdepth = temp
tempd.d = ReadPreferenceDouble("samplerate", 44100)
sampleRate = tempd
ClosePreferences()
;AddKeyboardShortcut(2, #PB_Shortcut_Return, 1)
;AddKeyboardShortcut(2, #PB_Shortcut_O, 1)
AddGadgetItem(#gadChannels, -1, "Mono")
AddGadgetItem(#gadChannels, -1, "Stereo")
SetGadgetState(#gadChannels, channels - 1)
AddGadgetItem(#gadBitDepth,-1,"16 bits")
AddGadgetItem(#gadBitDepth,-1,"24 bits")
If bitDepth = 16
SetGadgetState(#gadBitDepth, 0)
ElseIf bitDepth = 24
SetGadgetState(#gadBitDepth, 1)
EndIf
AddGadgetItem(#gadSampleRate,-1,"6000 Hz")
AddGadgetItem(#gadSampleRate,-1,"7200 Hz")
AddGadgetItem(#gadSampleRate,-1,"8000 Hz")
AddGadgetItem(#gadSampleRate,-1,"11025 Hz")
AddGadgetItem(#gadSampleRate,-1,"12000 Hz")
AddGadgetItem(#gadSampleRate,-1,"16000 Hz")
AddGadgetItem(#gadSampleRate,-1,"22050 Hz")
AddGadgetItem(#gadSampleRate,-1,"24000 Hz")
AddGadgetItem(#gadSampleRate,-1,"32000 Hz")
AddGadgetItem(#gadSampleRate,-1,"44100 Hz")
AddGadgetItem(#gadSampleRate,-1,"48000 Hz")
AddGadgetItem(#gadSampleRate,-1,"64000 Hz")
AddGadgetItem(#gadSampleRate,-1,"88200 Hz")
AddGadgetItem(#gadSampleRate,-1,"96000 Hz")
AddGadgetItem(#gadSampleRate,-1,"192000 Hz")
Select sampleRate
Case 6000
SetGadgetState(#gadSampleRate, 0)
Case 7200
SetGadgetState(#gadSampleRate, 1)
Case 8000
SetGadgetState(#gadSampleRate, 2)
Case 11025
SetGadgetState(#gadSampleRate, 3)
Case 12000
SetGadgetState(#gadSampleRate, 4)
Case 16000
SetGadgetState(#gadSampleRate, 5)
Case 22050
SetGadgetState(#gadSampleRate, 6)
Case 24000
SetGadgetState(#gadSampleRate, 7)
Case 32000
SetGadgetState(#gadSampleRate, 8)
Case 44100
SetGadgetState(#gadSampleRate, 9)
Case 48000
SetGadgetState(#gadSampleRate, 10)
Case 64000
SetGadgetState(#gadSampleRate, 11)
Case 88200
SetGadgetState(#gadSampleRate, 12)
Case 96000
SetGadgetState(#gadSampleRate, 13)
Case 192000
SetGadgetState(#gadSampleRate, 14)
EndSelect
SetGadgetState(#gadDevice, 0)
Repeat ;GET USER SELECTIONS
event = WaitWindowEvent()
If event = #PB_Event_CloseWindow
Pa_Terminate()
CloseWindow(2)
End
EndIf
If event = #PB_Event_Menu ;KEYBOARD SHORTCUTS
menuItem = EventMenu()
Select menuItem
Case 1: Break ;ENTER KEY ACCEPTS SETTINGS AND CLOSES WINDOW
EndSelect
ElseIf event = #PB_Event_Gadget
Select EventGadget()
Case #gadDevice
source_device = GetGadgetItemData(#gadDevice, GetGadgetState(#gadDevice))
Case #gadSampleRate
temp = GetGadgetState(#gadSampleRate)
Select temp
Case 0 : samplerate = 6000
Case 1 : samplerate = 7200
Case 2 : samplerate = 8000
Case 3 : samplerate = 11025
Case 4 : samplerate = 12000
Case 5 : samplerate = 16000
Case 6 : samplerate = 22050
Case 7 : samplerate = 24000
Case 8 : samplerate = 32000
Case 9 : samplerate = 44100
Case 10 : samplerate = 48000
Case 11 : samplerate = 64000
Case 12 : samplerate = 88200
Case 13 : samplerate = 96000
Case 14 : samplerate = 192000
EndSelect
Case #gadChannels
temp = GetGadgetState(#gadChannels)
Select temp
Case 0 : channels = #MONO
Case 1 : channels = #STEREO
EndSelect
Case #gadBitDepth
Select GetGadgetState(#gadBitDepth)
Case 0 : bitDepth = 16
Case 1 : bitDepth = 24
EndSelect
EndSelect
EndIf
Until EventGadget() = #gadOK
CloseWindow(2)
Global Dim *Devices.PaDeviceInfo(0)
DeviceCount.i
DefaultOutputIndex.i
DefaultInputIndex.i
Select bitDepth
Case 16
sampleFormat = #paInt16
Case 24
sampleFormat = #paInt24
EndSelect
bytesPerFrame = (bitdepth / 8) * channels
framesPerBuffer = sampleRate / 20 ;REFRESH 20 TIMES PER SECOND
period.f = (1 / sampleRate) * 1000
*bigBufferSize = Int((#BUFFER_DURATION / period) + 0.5) + 8
*bigBufferSize * bytesPerFrame
ch2Offset = (bitDepth / 8)
ch3Offset = (bitDepth / 8) * 2
ch4Offset = (bitDepth / 8) * 3
in_streamparms\device = source_device ;: Debug "device: " + Str(in_streamparms\device)
in_streamparms\channelCount = channels ;: Debug "Channels: " + Str(in_streamparms\channelCount)
in_streamparms\sampleFormat = sampleFormat ;: Debug "sample format: " + Str(in_streamparms\sampleFormat)
in_streamparms\suggestedLatency = 0 ;#SUGGESTED_LATENCY
If api_source$(source_device) = "WASAPI"
in_streamparms\hostApiSpecificStreamInfo = @WasapiInfo
Else
in_streamparms\hostApiSpecificStreamInfo = #Null
EndIf
OpenPreferences("." + slash$ + "PA Recorder.ini")
If result = #False
MessageRequester("Warning", "Unable to write to preferences file.")
EndIf
WritePreferenceLong("channels", channels)
WritePreferenceLong("bitdepth", bitDepth)
WritePreferenceDouble("samplerate", sampleRate)
ClosePreferences()
EndProcedure
Procedure WaveHeader(filenum)
If channels > 2 ;Or bitDepth > 16 ;PER MICROSOFT DOCUMENTATION
my_wfe\format\wFormatTag.u = #WAVE_FORMAT_EXTENSIBLE
Else
my_wfe\format\wFormatTag.u = #WAVE_FORMAT_PCM
EndIf
samprate.l = samplerate
byterate.l = samprate * bytesPerFrame
blockalign.u = channels * (bitdepth / 8)
bitsPerSample.u = bitdepth
my_WFE\format\nChannels = channels
my_WFE\format\nSamplesPerSec = samprate
my_WFE\format\nAvgBytesPerSec = samplerate * bytesPerFrame
my_WFE\format\nBlockAlign = channels * (bitsPerSample / 8)
my_WFE\format\wBitsPerSample = bitsPerSample
;Extensible part:
If my_wfe\format\wFormatTag = #WAVE_FORMAT_EXTENSIBLE
my_wfe\format\cbSize = 22 ;Size of Extensible part in bytes (SubFormat + wValidBitsPerSample + dwChannelMask)
subchunk1size.l = SizeOf(WAVEFORMATEXTENSIBLE)
my_wfe\wValidBitsPerSample = bitsPerSample
my_wfe\dwChannelMask = 7 ;#SPEAKER_STEREO | #SPEAKER_FRONT_CENTER
;GUID
;my_wfe\SubFormat\Data1 = #WAVE_FORMAT_PCM
;my_wfe\SubFormat\Data2 = $00
;my_wfe\SubFormat\Data3 = $10
;my_wfe\SubFormat\Data4[0] = $80
;my_wfe\SubFormat\Data4[1] = $00
;my_wfe\SubFormat\Data4[2] = $00
;my_wfe\SubFormat\Data4[3] = $aa
;my_wfe\SubFormat\Data4[4] = $00
;my_wfe\SubFormat\Data4[5] = $38
;my_wfe\SubFormat\Data4[6] = $9b
;my_wfe\SubFormat\Data4[7] = $71
Else
;NOT EXTENSIBLE
my_wfe\format\cbSize = 0 ;Size of Extensible part in bytes( SubFormat + wValidBitsPerSample + dwChannelMask)
subchunk1size.l = SizeOf(MYWAVEFORMATEX)
EndIf
chunksize = 20 + subchunk1Size
; Choose channel mask:
;Select #CHANNELS ;my_wfe\Format\nChannels
; Case 0
; my_wfe\dwChannelMask = #SPEAKER_DIRECTOUT
; Case 1
; my_wfe\dwChannelMask = #SPEAKER_MONO
; Case 2
; my_wfe\dwChannelMask = #SPEAKER_STEREO
; Case 3
;my_wfe\dwChannelMask = 7 ;#SPEAKER_STEREO | #SPEAKER_FRONT_CENTER
; Case 4
; my_wfe\dwChannelMask = #SPEAKER_QUAD
; Case 5
; my_wfe\dwChannelMask = #SPEAKER_QUAD | #SPEAKER_FRONT_CENTER
; Case 6
; my_wfe\dwChannelMask = #SPEAKER_5POINT1_SURROUND
; Case 7
; my_wfe\dwChannelMask = #SPEAKER_5POINT1_SURROUND | #SPEAKER_BACK_CENTER
; Case 8
; my_wfe\dwChannelMask = #SPEAKER_7POINT1_SURROUND
;EndSelect
;#define STATIC_KSDATAFORMAT_SUBTYPE_PCM\
; DEFINE_WAVEFORMATEX_GUID(WAVE_FORMAT_PCM)
;DEFINE_GUIDSTRUCT("00000001-0000-0010-8000-00aa00389b71", KSDATAFORMAT_SUBTYPE_PCM);
;#define KSDATAFORMAT_SUBTYPE_PCM DEFINE_GUIDNAMED(KSDATAFORMAT_SUBTYPE_PCM)
;WRITE WAV HEADER
WriteString(filenum, "RIFF") ; 4 bytes
WriteLong(filenum, chunksize) ; 4 bytes
WriteString(filenum, "WAVE") ; 4 bytes
WriteString(filenum, "fmt ") ; 4 bytes
WriteLong(filenum, subchunk1size) ; 4 bytes
;WRITE STRUCTURE
If my_wfe\format\wFormatTag = #WAVE_FORMAT_EXTENSIBLE
WriteData(filenum, my_WFE, SizeOf(WAVEFORMATEXTENSIBLE))
Else
WriteData(filenum, my_WFE, SizeOf(MYWAVEFORMATEX))
EndIf
WriteString(filenum, "data", #PB_Ascii) ; 4 bytes
WriteLong(filenum, 0) ; 4 BYTES -- subchunk2Size WILL GO HERE
;END OF FILE HEADER
EndProcedure
;==============================================================================
Procedure RECORD_Start()
;StickyWindow(1, #True)
totalBytes.q = 0
;CREATE WAV FILE
cutCounter = GetGadgetState(#gadCutCounter)
file_name$ = "." + slash$ + Right("0000000" + Str(cutCounter), 8) + ".wav"
fsize.q = FileSize(file_name$)
If fsize <> -1
result = MessageRequester("Overwrite file?", "File " + GetFilePart(file_name$) + " already exists. Overwrite existing file?" ,#PB_MessageRequester_YesNo)
If result = #PB_MessageRequester_No
Goto doNotRecord ;DO NOT OVERWRITE FILE
EndIf
EndIf
filehandle1 = CreateFile(1, file_name$)
If filehandle1 = 0
MessageRequester("Error", "Unable to create record file.")
shutdown()
EndIf
SetGadgetText(#gadRecording, "Recording to file " + GetFilePart(file_name$))
waveHeader(1)
DisableGadget(#gadRecord, 1)
DisableGadget(#gadStop, 0)
elapsed_seconds = 0
remaining_seconds = buffersize / samplerate
record_seconds = remaining_seconds
secns = 0
recording_now = #True
firstPass = #True
doNotRecord:
;Pa_StartStream(*my_stream)
EndProcedure
Procedure AudioLoop(null)
Repeat
If killThread1 = #False
WaitSemaphore(audioSemaphore)
If recording_now = #True And firstPass = #False ;THROW AWAY FIRST BUFER TO SYNCHRONIZE AND AVOID GLITCH AT START
If totalBytes.q + bytesToWrite >= maxBytes.q ;MAXIMUM FILE SIZE REACHED
SetGadgetText(#gadEndOfFile, "Recording stopped. Maximum file size reached.")
Record_Stop()
Else
writeFlag = #True
bytesToWrite = RingBufferBytesToRead(@RB1): RingBufferGet(@RB1, *buffer2, bytesToWrite)
WriteData(1, *buffer2, bytesToWrite)
writeFlag = #False
totalBytes + bytesToWrite
EndIf
EndIf
If firstPass = #True
firstPass = #False
recBoxFlag = #BRIGHT_RED
secns = 0
EndIf
Else ;killThread1 = #True
KillThread(threadID1)
EndIf
Until audioLoopContinue = #False
EndProcedure
;***********************************************************************************
;- START OF PROGRAM
;***********************************************************************************
DisableDebugger
If OSVersion() < 1000 ;WINDOWS
slash$ = "\"
NO_DRAG_Y = -22
Else
slash$ = "/" ;MAC AND LINUX
NO_DRAG_Y = 68
EndIf
result = Pa_Initialize()
If result <> #paNoError
*err = Pa_GetErrorText(result): error.string = @*err
MessageRequester("Unable to initialize PortAudio", error\s)
End ;shutdown()
EndIf
source_device = 0: getSettings()
;*buffer1 = AllocateMemory3((*bigBufferSize * #BIG_BUFFER_MULTIPLIER) + 6) ;APPROXIMATELY 30 SECONDS OF AUDIO
*buffer1 = AllocateMemory3(*bigBufferSize) ;APPROXIMATELY 30 SECONDS OF AUDIO
If *buffer1 = #Null
MessageRequester("Error", "Unable to allocate memory 1.")
End
EndIf
FileBuffersSize(1, bigBufferSize) ;LET SYSTEM BUFFER FILES
*dealloc1 = *buffer1
remainder.f = Mod(*buffer1, 4)
If remainder <> 0: *buffer1 + 2: EndIf; TRY TO FORCE BUFFER TO A 4-BYTE BOUNDARY
*buffer2 = AllocateMemory3(*bigBufferSize) ;APPROXIMATELY 30 SECONDS OF AUDIO
If *buffer2 = #Null
MessageRequester("Error", "Unable to allocate memory 2.")
End
EndIf
*dealloc2 = *buffer2
remainder.f = Mod(*buffer2, 4)
If remainder <> 0: *buffer2 + 2: EndIf; TRY TO FORCE BUFFER TO A 4-BYTE BOUNDARY
bbs = *bigBufferSize: RingBufferInit(@RB1, bbs)
offset = 0: *bufLimit = (*buffer1 + *bigBufferSize) - 16 ;GIVE IT A SAFETY FACTOR
quantity = 0
;maxBytes.q = (2048 * 1024 * 1024) - (*bigBufferSize * #BIG_BUFFER_MULTIPLIER) ;2147483648 -- 2 GB MAXIMUM FILE SIZE
maxBytes.q = (2048 * 1024 * 1024) - *bigBufferSize ;2147483648 -- 2 GB MAXIMUM FILE SIZE
OpenWindow(1, 0, NO_DRAG_Y, 1000, 600, "PA Recorder")
;StickyWindow(1, #True)
SetWindowColor(1, #BG_COLOR)
winWidth = WindowWidth(1): center = winWidth / 2
LoadFont(1, "Geneva", 60)
LoadFont(2, "Geneva", 18)
StartDrawing(WindowOutput(1))
FrontColor(0)
BackColor(#BG_COLOR)
DrawingFont(FontID(1))
StopDrawing()
AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_R, 1) ;CTRL "R" TO START RECORDING
AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_S, 2) ;CTRL "S" TO STOP RECORDING
AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_X, 3) ;CTRL "X" TO EXIT/QUIT PROGRAM
AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_Q, 4) ;CTRL "Q" TO EXIT/QUIT PROGRAM
AddKeyboardShortcut(1, #PB_Shortcut_Return, 6) ;"RETURN" KEY TO CONFIRM STOP
AddKeyboardShortcut(1, #PB_Shortcut_Escape, 7) ;"ESCAPE" KEY TO ABORT STOP
;LineXY(center, 0, center, 800, 0)
SpinGadget(#gadCutCounter, 300, 35, 80, 30, 1, 999, #PB_Spin_Numeric): SetGadgetFont(#gadCutCounter, FontID(2))
cutCounter = 1: SetGadgetState(#gadCutCounter, cutCounter)
ButtonGadget(#gadRecord, 40, 20, #BUTTON_WIDTH, 40, "Record")
ButtonGadget(#gadStop, 220, 20, #BUTTON_WIDTH, 40, "Stop")
DisableGadget(#gadRecord, 0)
ButtonGadget(#gadExit, winWidth - 40, 0, 40, 30, "Exit")
DisableGadget(#gadStop, 1)
TextGadget(#gadtoRecord, 35, 80, 80, 15, "Ctrl-R"): SetGadgetColor(#gadToRecord, #PB_Gadget_BackColor, #BG_COLOR)
TextGadget(#gadtoStop, 225, 80, 70, 15, "Ctrl-S"): SetGadgetColor(#gadToStop, #PB_Gadget_BackColor, #BG_COLOR)
TextGadget(#gadRecording, 20, #TEXT_Y + 40, 960, 26, "")
SetGadgetFont(#gadRecording, FontID(2))
SetGadgetColor(#gadRecording, #PB_Gadget_BackColor, #BG_COLOR)
TextGadget(#gadEndOfFile, 20, 460, 510, 26, "")
SetGadgetFont(#gadEndOfFile, FontID(2)): SetGadgetColor(#gadEndOfFile, #PB_Gadget_BackColor, #BG_COLOR)
TextGadget(#gadNextCutText, 310, 17, 50, 18, "Next cut #"): SetGadgetColor(#gadNextCutText, #PB_Gadget_BackColor, #BG_COLOR)
;TRY ALSO STRING GADGET
TextGadget(#gadConfirm, 470, 20, 190, 55, "", #PB_Button_MultiLine)
SetGadgetColor(#gadConfirm, #PB_Gadget_BackColor, #BG_COLOR): SetGadgetColor(#gadConfirm, #PB_Gadget_FrontColor, $00ffff)
SetGadgetFont(#gadConfirm, FontID(2))
audioSemaphore = CreateSemaphore(0)
CompilerIf(#PB_Compiler_OS = #PB_OS_Windows)
;SET THIS PROGRAM TO RUN AT REAL-TIME PRIORITY
result = SetPriorityClass_(GetCurrentProcess_(), #REALTIME_PRIORITY_CLASS) ;COMMENT THIS LINE OUT FOR MAC
;MAKES AVAILABLE PRIORITIES 16 - 31 WHEN LOGGED ON As ADMINISTRATOR
;SEE http://music.columbia.edu/pipermail/portaudio/2004-February/003120.html
CompilerEndIf
StreamStart()
audioLoopContinue = #True
threadID1 = CreateThread(@audioLoop(), #Null) ;THREAD TO MONITOR CALLBACK FLAG
CompilerIf(#PB_Compiler_OS = #PB_OS_Windows)
SetThreadPriority_(ThreadID(threadID1), #THREAD_PRIORITY_ABOVE_NORMAL) ;COMMENT THIS LINE OUT FOR MAC
; PRIORITY = 25 AS ADMINISTRATOR -- WASAPI CODE RUNS AT PRIORITY 26
CompilerEndIf
alertBoxFlag = #BRIGHT_RED
Repeat ;MAIN EVENT LOOP
event = WaitWindowEvent(10)
Select event
Case #PB_Event_Menu ;KEYBOARD SHORTCUTS
menuItem = EventMenu()
If menuItem = 1 And recording_now = #False;CTRL-R TO RECORD
Record_Start()
ElseIf menuItem = 2 And recording_now = #True ;CTRL-S TO STOP
stopFlag = #True
SetGadgetText(#gadConfirm, "Press Enter to stop" + Chr(10) + Chr(13) + "Press ESC to continue")
SetGadgetColor(#gadConfirm, #PB_Gadget_BackColor, $0000dd)
ElseIf menuItem = 3 Or menuItem = 4 ;CTRL-X OR CTRL-Q TO QUIT PROGRAM
If recording_now = #True
quitFlag = #True
SetGadgetText(#gadConfirm, "Press Enter to quit Press Esc to continue")
SetGadgetColor(#gadConfirm, #PB_Gadget_BackColor, $0000dd)
Else
shutdown()
EndIf
ElseIf menuItem = 6 ;"RETURN" KEY TO CONFIRM STOP/QUIT
SetGadgetText(#gadConfirm, "")
SetGadgetColor(#gadConfirm, #PB_Gadget_BackColor, #BG_COLOR)
If stopFlag = #True: stopFlag = #False: Record_Stop()
ElseIf quitFlag = #True: shutdown()
EndIf
ElseIf menuItem = 7 ;"ESCAPE" KEY TO ABORT STOP/QUIT
SetGadgetText(#gadConfirm, ""): stopFlag = #False: quitFlag = #False
SetGadgetColor(#gadConfirm, #PB_Gadget_BackColor, #BG_COLOR)
EndIf
Case #PB_Event_Gadget
event_gadget = EventGadget()
Select event_gadget
Case #gadRecord
RECORD_Start()
Case #gadStop
stopFlag = #True
SetGadgetText(#gadConfirm, "Press Enter to stop" + Chr(10) + "Press ESC to continue")
SetGadgetColor(#gadConfirm, #PB_Gadget_BackColor, $0000dd)
Case #gadSettings
getsettings()
Pa_StopStream(*my_stream)
Pa_StartStream(*my_stream)
Case #gadExit
If recording_now = #True
quitFlag = #True
SetGadgetText(#gadConfirm, "Press Enter to quit" + Chr(10) + "Press ESC to continue")
SetGadgetColor(#gadConfirm, #PB_Gadget_BackColor, $0000dd)
Else
shutdown()
EndIf
EndSelect ;event gadget
Case #PB_Event_Repaint
If firstPass = #False
If recording_now = #True
recBoxFlag = #BRIGHT_RED
ElseIf recording_now = #False
recBoxFlag = #STOP_RED
EndIf
EndIf
Case #PB_Event_CloseWindow
ShutDown()
EndSelect
ForEver