Here is a example program that will take an audio sample, stretch it out in time but will preserve the pitch. It’s based loosely on paulstretch.
Written in BlitzMax NG. The program is written for simplicity not speed.
The important variables are:
ScaleFactor : how much to stretch the audio, a value of 3 would be 3 times the original length.
WindowLen: Larger makes a cleaner sound but is slower to run. Must be a power of 2.
Number of threads to run: This should less that the number of logical cores on your cpu.
Hit escape key to exit the program. Download windows exe, sourcecode and included audio file HERE 
'// Time stretch audio roughly based on paulstretch by A.Woodard [aaron at kerneltrick.com]
SuperStrict
Import brl.glmax2d
Import brl.threadpool
Import pub.freeaudio
Import brl.audio
Import brl.audiosample
Import brl.wavloader
Import brl.oggloader
AppTitle = "Timestretch audio in BlitzMax"
Type TTask Extends TRunnable
Global mutex:TMutex = TMutex.Create()
Field Readpos:Int, Writepos:Int
Method New(Rp:Int, Wp:Int)
ReadPos = Rp
Writepos = Wp
Print("task::new")
End Method
Method run()
DoChunk(ReadPos, writepos, mutex)
Delay 2
End Method
End Type
SeedRnd(MilliSecs())
Const TWOPI:Double = Pi * 2
Const GW:Int = 800
Const GH:Int = 600
Const OrigAudioFile:String = "dhm.wav"
Global Tpool:TThreadPoolExecutor = TThreadPoolExecutor.newFixedThreadPool(4) '// Num threads should be less than cpu cores
Global Origdata:Float[]
Global ScaleFactor:Float = 4 '// How much to stretch the audio
Global Newdata:Float[(Origdata.length * scalefactor) + 1]
Global WindowLen:Float = 1024 * 4 '// Window size, larger sounds better but is slower
Global Offset:Float = (WindowLen / 2) / (ScaleFactor)
Global ReadPos:Int = 0
Global N:Int = windowlen
Global orig:TAudioSample
Graphics GW, GH,0,10
DoStretch()
While Not KeyHit(KEY_ESCAPE)
Cls
DrawData()
'DrawText(Tpool.threadCount + " " + Tpool.threadsWorking, 10, 10)
If KeyHit(KEY_1) And Tpool.threadsWorking = 0 Then
PlaySound(LoadSound(orig))
EndIf
If KeyHit(KEY_2) And Tpool.threadsWorking = 0 Then
Local newdat:Short[Newdata.length]
For Local i:Int = 0 Until newdat.Length
newdat[i] = Newdata[i] * 32767
Next
Local newsamp:TAudioSample = New TAudioSample()
newsamp.format = SF_MONO16LE
newsamp = newsamp.CreateStatic(Varptr newdat[0], newdat.Length, 44100, SF_MONO16LE)
PlaySound(LoadSound(newsamp))
End If
If Tpool.threadsWorking = 0 Then
DrawText("Press 1 to play original sound, Press 2 to play stretched sound", 10, 10)
Else
DrawText("Working, wait....", 10, 10)
EndIf
Flip
Wend
'-------------------------------------------------------------------------------------------------
Function DoStretch()
Local cPos:Int
Local count:Int = 0
If Not(Not (WindowLen & (WindowLen - 1))) Then Notify("windowlen must be pow/2", 1) ;End
orig:TAudioSample = LoadAudioSample(OrigAudioFile) '// Assumes Mono. Using ogg sample beacuse this func hates .wav
If Not orig Then Notify("Cant load audio", 1) ;End
orig = orig.Convert(SF_MONO16LE)
Origdata = New Float[orig.Length]
Local p:Short Ptr = Short Ptr(orig.samples)
For Local i:Int = 0 Until orig.Length
Origdata[i] = 0.8 * ((Float(Short(32767 - p[0])) / 32767.0) - 1.0)
p:+1
Next
Newdata = New Float[(Origdata.Length * ScaleFactor) + 1]
While ReadPos + WindowLen < Origdata.Length
CPos = ((N / 2) * Count)
Tpool.execute(New TTask(ReadPos, CPos))
Count:+1
ReadPos:+Offset
Wend
End Function
'-------------------------------------------------------------------------------------------------
Function DoChunk(Readpos:Int, Writepos:Int, mut:TMutex)
Print "HERE " + ReadPos + " " + Writepos
Local cp:Float[N]
Local sp:Float[N]
Local SpecBuff:Float[]
Local obuff:Float[]
Local isr:Float = 0.853
SpecBuff = Origdata[Readpos..(Readpos + N)]
For Local i:Int = 0 Until N
SpecBuff[i]:*Sine(Pi * i / (N))
Next
Speccy(SpecBuff, -1, cp, sp)
cp[0] = 0
sp[0] = 0
For Local i:Int = 0 Until N / 2
cp[i] = Sqr(cp[i] * cp[i] + sp[i] * sp[i])
Local p:Float = Rnd(-Pi, Pi)
sp[i] = cp[i] * Sine(p)
cp[i] = cp[i] * Cosine(p)
Next
Speccy(SpecBuff, 1, cp, sp)
For Local i:Int = 0 Until N
SpecBuff[i]:*Sine(Pi * i / N)
Next
mut.Lock()
For Local i:Int = 0 Until N '/ 2
Newdata[i + Writepos]:+(SpecBuff[i])
Newdata[i + Writepos]:*(isr - (1.0 - isr) * Sine(Pi * i / N))
Next
For Local i:Int = 0 Until N
Newdata[i + Writepos] = ClampOne(Newdata[i + Writepos])
Next
mut.Unlock
Function Speccy(buff:Float[], s:Int = -1, cp:Float[], sp:Float[]) '// Insanely slow !!!
If s = 1 Then
MemClear(Varptr buff[0], SizeOf(1:Float) * N)
For Local k:Int = 0 Until N
For Local b:Int = 0 Until N / 2
Local a:Float = 2.0 * b * Pi * k / N
buff[k]:+(cp[b] * Cosine(a)) + ((-sp[b]) * Sine(a))
Next
buff[k] = 2 * buff[k] / N
Next
Else
MemClear(Varptr cp[0], SizeOf(1:Float) * N)
MemClear(Varptr sp[0], SizeOf(1:Float) * N)
For Local k:Int = 0 Until N
For Local b:Int = 0 Until N / 2
Local a# = 2.0 * b * Pi * k / N
sp[b]:+Buff[k] * s * Sine(a)
cp[b]:+buff[k] * Cosine(a)
Next
Next
End If
EndFunction
End Function
'-------------------------------------------------------------------------------------------------
Function DrawData()
Local x:Float
Local xs:Float = GW / Float(Newdata.length)
For Local i:Int = 0 Until Origdata.Length
DrawRect(x, 200 + Origdata[i] * 100, 2, 1)
x:+xs
Next
x = 0
For Local i:Int = 0 Until Newdata.Length
DrawRect(x, 400 + Newdata[i] * 100, 2, 1)
x:+xs
Next
SetColor 255, 0, 255
DrawText("Original", 50, 200 - 5)
DrawText("Streched", 50, 400 - 5)
SetColor 255, 255, 255
'DrawRect(0, 200, 1000, 1)
Delay 10
End Function
'-------------------------------------------------------------------------------------------------
Function Sine:Double(x:Double) inline
Local k:Int;Local y:Double;Local z:Double
z = x
z:*0.3183098861837907
z:+6755399441055744.0
k = Int Ptr(Varptr(z))[0]
z = k
z:*3.1415926535897932
x:-z;y = x;y:*x
z = 0.0073524681968701
z:*y
z:-0.1652891139701474
z:*y
z:+0.9996919862959676
x:*z;k:&1;k:+k;z = k;z:*x;x:-z
Return x
End Function
'-------------------------------------------------------------------------------------------------
Function Cosine:Double(x:Double) Inline
Return Sine((3.1415926535897932 / 2.0) - x)
End Function
'-------------------------------------------------------------------------------------------------
Function ClampOne:Double(x:Double) Inline
Return 0.5 * (Abs(x + 1) - Abs(x - 1))
End Function
'-------------------------------------------------------------------------------------------------