Option Explicit

' Windows API for multimedia control
Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Integer) As Integer

Private Declare PtrSafe Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" _
    (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

Dim OpenAliases As Object ' Dictionary to track open aliases
Dim OnTimeSchedules As Object ' Dictionary to track scheduled OnTime calls
Dim IsMonitoring As Boolean ' Flag for monitoring loop

' Initialize alias tracking
Sub InitializeAliasTracking()
    Set OpenAliases = CreateObject("Scripting.Dictionary")
    Set OnTimeSchedules = CreateObject("Scripting.Dictionary")
    Debug.Print "? Initialized alias tracking."
    StartMonitoring
End Sub

' Start monitoring cell values
Sub StartMonitoring()
    IsMonitoring = True
    Debug.Print "?? Monitoring started."
    MonitorCells
End Sub

' Stop monitoring
Sub StopMonitoring()
    IsMonitoring = False
    Debug.Print "? Monitoring stopped."
    MsgBox "Monitoring Stopped"
End Sub

' Read cell values and manage sound playback
Sub MonitorCells()
    Dim CurrentA1 As Integer, CurrentA2 As Integer, CurrentA4 As Integer, CurrentB3 As Integer

    ' Read cell values
    CurrentA1 = Range("A1").Value
    CurrentA2 = Range("A2").Value
    CurrentB3 = Range("B3").Value
    CurrentA4 = Range("A4").Value

    ' Stop all sounds if B3 = 1
    If CurrentB3 = 1 Then
        Debug.Print "? Stopping all sounds."
        Call StopAllSounds
    End If

    ' Manage A1 sound
    If CurrentA1 = 1 And (Left(GetSoundStatus("Sound1"), 3) <> "pla") Then
        Call PlaySound("Sound1", "C:\Users\beaud\Downloads\01.wav", True, 100)
    ElseIf CurrentA1 = 0 And (Left(GetSoundStatus("Sound1"), 3) = "pla" Or Left(GetSoundStatus("Sound1"), 7) = "pau") Then
        Call StopSound("Sound1")
    End If

    ' Manage A2 sound
    If CurrentA2 = 1 And (Left(GetSoundStatus("Sound2"), 3) <> "pla") Then
        Call PlaySound("Sound2", "C:\Users\beaud\Downloads\02.mp3", False)
    ElseIf CurrentA2 = 0 And (Left(GetSoundStatus("Sound2"), 3) = "playing" Or Left(GetSoundStatus("Sound2"), 7) = "pau") Then
        Call StopSound("Sound2")
    End If

    ' Manage A4 sound
    If CurrentA4 = 1 And (Left(GetSoundStatus("Sound5"), 3) <> "pla") Then
        Call PlaySound("Sound5", "C:\Users\beaud\Downloads\05.mp3", True)
    ElseIf CurrentA4 = 0 And (Left(GetSoundStatus("Sound5"), 3) = "playing" Or Left(GetSoundStatus("Sound5"), 7) = "pau") Then
        Call StopSound("Sound5")
    End If

    If IsMonitoring Then
        Application.OnTime Now + (1 / 86400), "MonitorCells"
    End If
End Sub

' Play sound with seamless looping
Sub PlaySound(ByVal AliasName As String, ByVal FilePath As String, ByVal repeat As Boolean, Optional vol As Integer = 1000)
    AliasName = LCase(AliasName)
    Dim status As String * 255
    mciSendString "status " & AliasName & "_1 mode", status, 255, 0
    status = Left(Trim(status), 3)

    ' Ensure alias tracking is initialized
    If OpenAliases Is Nothing Then Set OpenAliases = CreateObject("Scripting.Dictionary")
    If OnTimeSchedules Is Nothing Then Set OnTimeSchedules = CreateObject("Scripting.Dictionary")
Debug.Print "?? Status" & status
    ' If status is empty (alias not opened), force open and play
    If status <> "pla" Then
        Debug.Print "? Alias does not exist yet. Opening " & AliasName & "_1"
        mciSendString "open """ & FilePath & """ alias " & AliasName & "_1", vbNullString, 0, 0
        OpenAliases.Add AliasName & "_1", repeat
    End If

    ' If sound is already playing, do nothing
    If status = "pla" Then
        Debug.Print "? " & AliasName & "_1 is already playing. No need to restart."
        Exit Sub
    End If

    ' If stopped or unknown state, seek to start and play
    Debug.Print "? Playing " & AliasName & "_1"
    mciSendString "seek " & AliasName & "_1 to start", vbNullString, 0, 0
    mciSendString "play " & AliasName & "_1", vbNullString, 0, 0

    ' If repeat is enabled, prepare seamless looping
    If repeat = True Then
        If Not OpenAliases.exists(AliasName & "_2") Then
            mciSendString "open """ & FilePath & """ alias " & AliasName & "_2", vbNullString, 0, 0
            OpenAliases.Add AliasName & "_2", repeat
        End If

        Dim soundLength As Long
        soundLength = GetSoundLength(AliasName & "_1")
        Dim nextRunTime As Double
        nextRunTime = Now + ((soundLength - 100) / 1000) / 86400

        ' Store the scheduled time and call seamless overlap
        If OnTimeSchedules.exists(AliasName) Then OnTimeSchedules.Remove AliasName
        OnTimeSchedules.Add AliasName, nextRunTime
        Application.OnTime OnTimeSchedules(AliasName), "'" & "SeamlessOverlap """ & AliasName & """'"

        mciSendString "setaudio " & AliasName & "_2 volume to " & vol, vbNullString, 0, 0
    Else
        mciSendString "setaudio " & AliasName & "_1 volume to " & vol, vbNullString, 0, 0
    End If
End Sub


' Seamless looping between aliases
Sub SeamlessOverlap(ByVal AliasName As String)
    AliasName = LCase(AliasName)
    Dim nextAlias As String, currentAlias As String, status As String * 255
    mciSendString "status " & AliasName & "_1 mode", status, 255, 0
    status = Left(Trim(status), 3)

    If status = "pla" Then
        currentAlias = AliasName & "_1"
        nextAlias = AliasName & "_2"
    Else
        currentAlias = AliasName & "_2"
        nextAlias = AliasName & "_1"
    End If

    If OpenAliases.exists(currentAlias) Then
        Debug.Print "?? Switching from " & currentAlias & " to " & nextAlias
        mciSendString "play " & nextAlias, vbNullString, 0, 0
    End If
End Sub

' Stop playback and clear scheduled events
Sub StopSound(ByVal AliasName As String)
    AliasName = LCase(AliasName)

    If OpenAliases.exists(AliasName & "_1") Then
        mciSendString "stop " & AliasName & "_1", vbNullString, 0, 0
        mciSendString "close " & AliasName & "_1", vbNullString, 0, 0
        OpenAliases.Remove AliasName & "_1"
    End If
If OpenAliases.exists(AliasName & "_2") Then
        mciSendString "stop " & AliasName & "_2", vbNullString, 0, 0
        mciSendString "close " & AliasName & "_2", vbNullString, 0, 0
        OpenAliases.Remove AliasName & "_2"
    End If
    If OnTimeSchedules.exists(AliasName) Then
        Application.OnTime OnTimeSchedules(AliasName), "'" & "SeamlessOverlap """ & AliasName & """'", , False
        OnTimeSchedules.Remove AliasName
    End If

    Debug.Print "? Stopped " & AliasName
End Sub
' Stop all sounds and reset them to the start
Sub StopAllSounds()
    Dim AliasName As Variant
    For Each AliasName In OpenAliases.Keys
        If OpenAliases.exists(AliasName & "_1") Then
        mciSendString "stop " & AliasName & "_1", vbNullString, 0, 0
        mciSendString "close " & AliasName & "_1", vbNullString, 0, 0
        OpenAliases.Remove AliasName & "_1"
    End If
If OpenAliases.exists(AliasName & "_2") Then
        mciSendString "stop " & AliasName & "_2", vbNullString, 0, 0
        mciSendString "close " & AliasName & "_2", vbNullString, 0, 0
        OpenAliases.Remove AliasName & "_2"
    End If
    If OnTimeSchedules.exists(AliasName) Then
        Application.OnTime OnTimeSchedules(AliasName), "'" & "SeamlessOverlap """ & AliasName & """'", , False
        OnTimeSchedules.Remove AliasName
    End If
    Next AliasName
End Sub

' Get sound length
Function GetSoundLength(ByVal AliasName As String) As Long
    AliasName = LCase(AliasName)
    Dim lengthStr As String * 255
    mciSendString "status " & AliasName & " length", lengthStr, 255, 0
    GetSoundLength = Val(lengthStr)
End Function

' Get sound status
Function GetSoundStatus(ByVal AliasName As String) As String
    AliasName = LCase(AliasName)
    Dim status As String * 255
    mciSendString "status " & AliasName & " mode", status, 255, 0
    GetSoundStatus = Trim(status)
End Function