Option Explicit
' WAV file constants
Private Const digitsofpi As Long = 2000
Private Const SAMPLE_RATE As Long = (digitsofpi \ 1) '(digitsofpi \ n) = Hz, (digitsofpi / (digitsofpi \ n)) = Seconds
Private Const BITS_PER_SAMPLE As Integer = 16
Private Const NUM_CHANNELS As Integer = 1   ' Mono

Sub Main()
 Application.ScreenUpdating = False
 Application.Calculation = False
 
 On Error GoTo Err:
    With Sheet1
        .Activate
        .Range("A1").Select
    End With
    Call GeneratePiDigits(digitsofpi, 20)
    Call PidigitsMap(digitsofpi)
  
 Exit Sub

Err:
 MsgBox "Error: " & Err.Description, vbCritical
 Application.ScreenUpdating = True
 Application.Calculation = True

End Sub

Sub GeneratePiDigits(numDigits As Long, maxrows As Long)
' Generates digits of Pi using a spigot algorithm
' Output values to sheet and colour code cell fill based on value in cell

    ' numDigits = number of digits in Pi
    ' maxrows = maximum rows per column
    
    Dim i As Long, k As Long
    Dim lastdigit As Long
    Dim digitcount As Long
    Dim digitStr As String, digit As String
    Dim row As Long
    Dim col As Long
        
    digitcount = 0
    lastdigit = 0
    k = 0
    row = 1
    col = 1
    
    ' Clear previous output
    Sheet1.Cells.Clear
       
    ' Generate digits
    For i = 0 To numDigits
        
        digitStr = Spigot(i, numDigits) 'digit group
                
        If i > 0 Then
            ' Write digits to cells
            For k = 1 To Len(digitStr)
                digitcount = lastdigit + k
                If digitcount <= numDigits Then
                    digit = Mid$(digitStr, k, 1)
                    With Sheet1.Cells(row, col)
                        .value = digit
                        .Interior.ColorIndex = Val(digit)
                    End With
                    If (digitcount Mod maxrows) = 0 Then row = 0: col = col + 1
                    row = row + 1
                End If
            Next k
            lastdigit = (lastdigit + (k - 1))
        End If
    
    Next i
    
End Sub

Sub PidigitsMap(numDigits As Long)

' Generates digits of Pi using a spigot algorithm

    ' numDigits = number of digits in Pi
    ' maxrows = maximum rows per column
    
    Dim i As Long, k As Long
    Dim lastdigit As Long
    Dim digitcount As Long
    Dim digitStr As String, digit As String
    Dim row As Long, col As Long
    Dim ref_angle As Integer
    Dim dir_angle As Long
    Dim scaleval
    Dim Xprev As Double, Yprev As Double
    Dim data_Arr()
    Dim numcols As Long
    Dim none As String
            
    digitcount = 0
    lastdigit = 0
    k = 0
    row = 1
    col = 1
    
    ref_angle = 36 'digits 0 to 9 = 10 values therefore direction angle per value is 36 degrees.
    dir_angle = 0
    scaleval = 1
    Xprev = 0
    Yprev = 0
    numcols = 6
    none = ""   'dummy value for passing parameter to hide sub from macro list
        
    ReDim data_Arr(1 To numDigits, 1 To numcols)
          
    ' Generate digits
    For i = 0 To numDigits
        
        digitStr = Spigot(i, numDigits)    'digit group
                
        If i > 0 Then
            ' Write digits to cells
            For k = 1 To Len(digitStr)
                digitcount = lastdigit + k
                If digitcount <= numDigits Then
                    digit = Mid$(digitStr, k, 1)
                    dir_angle = Val(digit) * ref_angle
                    data_Arr(row, 1) = row
                    data_Arr(row, 2) = row / numDigits  'sample rate
                    data_Arr(row, 3) = digit
                    data_Arr(row, 4) = dir_angle
                    data_Arr(row, 5) = ((Sin(dir_angle) * 4) * scaleval) + Xprev
                    data_Arr(row, 6) = ((Cos(dir_angle) * 4) * scaleval) + (Yprev * -1)
                    Xprev = data_Arr(row, 5)
                    Yprev = data_Arr(row, 6)
                    row = row + 1
                End If
            Next k
            lastdigit = (lastdigit + (k - 1))
        End If
    Next i

    Call normalization(data_Arr, 6)

    ' Output array to sheet
    With Sheet2
        .Cells.Clear
        .Range("A1").Resize(numDigits, numcols).value = data_Arr
    End With

    Call savefile(data_Arr, 6)

    Call CSV_To_WAV(none)

End Sub

Function Spigot(Iteration As Long, lengthofpi As Long) As Long
'Spigot algorithm setup
        
    Dim sum As Long
    Dim j As Long
    Dim i As Long
    Dim carry As Long
    Static lenArr As Long
    Static arr() As Long
    
    carry = 0
    
    If Iteration = 0 Then
        'initialize
        lenArr = lengthofpi * 10 \ 3
        ReDim arr(1 To lenArr) As Long
        For i = 1 To lenArr
            arr(i) = 2
        Next i
    Else
        sum = 0
        For j = lenArr To 1 Step -1
            sum = sum * j + 10000 * arr(j)
            arr(j) = sum Mod (2 * j - 1)
            sum = sum \ (2 * j - 1)
        Next j
        
        arr(1) = sum Mod 10000
        carry = sum \ 10000
        
        Spigot = Trim(Format$(carry, "####"))

    End If

End Function

Sub normalization(data_Arr, colidx As Integer)

' Normalize data_Arr between -1 and 1 using column colidx

    Dim i As Long
    Dim maxrw, maxcl
    ReDim maxrw(1 To UBound(data_Arr, 1))   'rows
    ReDim maxcl(1 To UBound(data_Arr, 2))   'columns
    Dim oldmin As Double, oldmax As Double
    
    'find min and max values in data_Arr() in column colidx
    oldmin = data_Arr(1, colidx)                    'first element in array column
    oldmax = data_Arr(UBound(data_Arr, 1), colidx)  'last element in array column
    For i = 1 To UBound(data_Arr, 1)
     If data_Arr(i, colidx) < oldmin Then oldmin = data_Arr(i, colidx)
     If data_Arr(i, colidx) > oldmax Then oldmax = data_Arr(i, colidx)
    Next i

    'update normalized values in data_Arr() in column colidx between -1 and 1
    For i = 1 To UBound(data_Arr, 1)
        data_Arr(i, colidx) = 2 * ((data_Arr(i, colidx) - oldmin) / (oldmax - oldmin)) - 1
    Next i
    
End Sub

Sub savefile(data_Arr, colidx As Integer)

    Dim filepath As String, txtdata As String
    Dim fileNum As Integer, i As Integer, j As Integer
        
    filepath = ThisWorkbook.Path & "\piwaveform.csv"
    fileNum = FreeFile
    
    'output file and automatically overwrite existing file with the same name
    Open filepath For Output As #fileNum
    For i = 1 To UBound(data_Arr, 1)
        txtdata = ""
        For j = 1 To UBound(data_Arr, 2)
            Select Case j
                Case colidx  'column or columns to be saved
                    txtdata = txtdata & data_Arr(i, j) & ","
            End Select
        Next j
        txtdata = Left(txtdata, Len(txtdata) - 1)
        Print #fileNum, txtdata
    Next i
    Close #fileNum
    
End Sub

Sub CSV_To_WAV(none)
    
    Dim csvPath As String, wavPath As String
    
    On Error GoTo ErrHandler
    
    csvPath = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "Select CSV File")
    If csvPath = "False" Then Exit Sub
    
    wavPath = Application.GetSaveAsFilename("output.wav", "WAV Files (*.wav), *.wav", , "Save WAV File As")
    If wavPath = "False" Then Exit Sub
    
    Dim fileNum As Integer, wavNum As Integer
    Dim samples() As Double
    Dim i As Long, sampleCount As Long
    Dim sampleValue As Double
    Dim dataBytes() As Byte
    
    ' Read CSV samples into array
    Dim temp As String
    Dim values As Variant
    Dim allSamples As Collection
    Set allSamples = New Collection
    
    fileNum = FreeFile
    Open csvPath For Input As #fileNum
        Do While Not EOF(fileNum)
            Line Input #fileNum, temp
            values = Split(temp, ",")
            For i = LBound(values) To UBound(values)
                If IsNumeric(values(i)) Then
                    allSamples.Add CDbl(values(i))
                End If
            Next i
        Loop
    Close #fileNum
    
    sampleCount = allSamples.Count
    If sampleCount = 0 Then
        MsgBox "No numeric samples found in CSV.", vbExclamation
        Exit Sub
    End If
    
    ' Convert samples to 16-bit PCM byte array
    ReDim dataBytes(0 To sampleCount * 2 - 1) As Byte
    For i = 1 To sampleCount
        sampleValue = allSamples(i)
        ' Clamp to -1.0 to 1.0 range
        If sampleValue > 1 Then sampleValue = 1
        If sampleValue < -1 Then sampleValue = -1
        ' Scale to 16-bit signed integer
        Dim intSample As Long
        intSample = CLng(sampleValue * 32767)
        ' Little-endian byte order
        dataBytes((i - 1) * 2) = intSample And &HFF
        dataBytes((i - 1) * 2 + 1) = (intSample \ &H100) And &HFF
    Next i
    
    ' Write WAV file
    wavNum = FreeFile
    Open wavPath For Binary As #wavNum
        Call WriteWavHeader(wavNum, sampleCount, SAMPLE_RATE, NUM_CHANNELS, BITS_PER_SAMPLE)
        Put #wavNum, , dataBytes
    Close #wavNum
    
    MsgBox "WAV file created successfully: " & wavPath, vbInformation
    Exit Sub
    
ErrHandler:
    MsgBox "Error: " & Err.Description, vbCritical
    On Error Resume Next
    Close #fileNum
    Close #wavNum
End Sub

Private Sub WriteWavHeader(ByVal fileNum As Integer, ByVal sampleCount As Long, _
                           ByVal sampleRate As Long, ByVal channels As Integer, _
                           ByVal bitsPerSample As Integer)
    Dim byteRate As Long
    Dim blockAlign As Integer
    Dim subchunk2Size As Long
    Dim chunkSize As Long
    
    blockAlign = channels * (bitsPerSample \ 8)
    byteRate = sampleRate * blockAlign
    subchunk2Size = sampleCount * blockAlign
    chunkSize = 36 + subchunk2Size
    
    ' RIFF header
    Put #fileNum, , "RIFF"
    Put #fileNum, , LongToBytes(chunkSize)
    Put #fileNum, , "WAVE"
    
    ' fmt subchunk
    Put #fileNum, , "fmt "
    Put #fileNum, , LongToBytes(16) ' Subchunk1Size for PCM
    Put #fileNum, , IntToBytes(1)   ' AudioFormat = PCM
    Put #fileNum, , IntToBytes(channels)
    Put #fileNum, , LongToBytes(sampleRate)
    Put #fileNum, , LongToBytes(byteRate)
    Put #fileNum, , IntToBytes(blockAlign)
    Put #fileNum, , IntToBytes(bitsPerSample)
    
    ' data subchunk
    Put #fileNum, , "data"
    Put #fileNum, , LongToBytes(subchunk2Size)
End Sub

Private Function LongToBytes(ByVal value As Long) As Byte()
    Dim b(0 To 3) As Byte
    b(0) = value And &HFF
    b(1) = (value \ &H100) And &HFF
    b(2) = (value \ &H10000) And &HFF
    b(3) = (value \ &H1000000) And &HFF
    LongToBytes = b
End Function

Private Function IntToBytes(ByVal value As Integer) As Byte()
    Dim b(0 To 1) As Byte
    b(0) = value And &HFF
    b(1) = (value \ &H100) And &HFF
    IntToBytes = b
End Function