Attribute VB_Name = "Queue"
Option Explicit

'----------------------------------------------------------
'  New Message Queue System
'----------------------------------------------------------
Public Declare Function myriad_queue_prepare Lib "myriadhelp.dll" () As Long
Public Declare Function myriad_queue_create Lib "myriadhelp.dll" _
    (ByVal NotifyProc As Long, ByVal TimingProc As Long) As Long
Public Declare Sub myriad_queue_destroy Lib "myriadhelp.dll" _
    (ByVal QueueID As Long)
Public Declare Function myriad_queue_get Lib "myriadhelp.dll" _
    (ByVal QueueID As Long, ByVal Out As String, ByVal BufLen As Long) As Long
Public Declare Sub myriad_queue_enqueue Lib "myriadhelp.dll" _
    (ByVal QueueID As Long, ByVal Messge As String, ByVal Priority As Long)
Public Declare Function myriad_queue_size Lib "myriadhelp.dll" _
    (ByVal QueueID As Long) As Long
Public Declare Sub myriad_queue_advance Lib "myriadhelp.dll" _
    (ByVal QueueID As Long)
Public Declare Sub myriad_queue_clear Lib "myriadhelp.dll" _
    (ByVal QueueID As Long)
Private Const QUEUE_BUSY_THRESHOLD& = 5
Private QueueID As Long


'----------------------------------------------------------
'  Event Queue
'----------------------------------------------------------
Private Declare Function SetTimer Lib "user32" _
    (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
    (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public Enum ChatEventTypes
    ceJoin
    ceLeave
    ceSay
    ceEmote
    ceWhisperRecv
    ceWhisperTo
    ceUserFlags
End Enum
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Private Type CHATEVENT
    Disabled As Boolean
    eType As ChatEventTypes
    User As String
    Client As bnProduct
    Ping As Long
    Flags As Long
    Message As String
    RelativeTime As Long
    Time As SYSTEMTIME
End Type
Private Const EVENT_QUEUE_BASE_SIZE& = 64
Private Const EVENT_QUEUE_DELAY& = 100
Private Const EVENT_FLOOD_THRESHOLD& = 80
Private Const EVENT_MASS_THRESHOLD& = 8
Private Const FLOODING_USERS_SIZE& = 175
Private EventQueueSize As Long
Private EventQueue() As CHATEVENT
Private EventQueueTimerID As Long
Private EventQueueRunning As Boolean
Private EventQueueExecuting As Boolean
Private FloodingUsers() As String
Private FloodingUserCount As Long
Private FloodingUserIndex As Long
Public useFloodFilter As Boolean, useMassFilter As Boolean, aggressiveFiltering As Boolean

Private Declare Sub GetLocalTime Lib "kernel32.dll" (lpSystemTime As SYSTEMTIME)

'----------------------------------------------------------
'  Event Queue Starter
'----------------------------------------------------------
Public Function StartEventQueue() As Boolean
    StopEventQueue
    ReDim EventQueue(EVENT_QUEUE_BASE_SIZE) As CHATEVENT
    ReDim FloodingUsers(FLOODING_USERS_SIZE) As String
    FloodingUserCount = 0
    EventQueueTimerID = SetTimer(0, 0, EVENT_QUEUE_DELAY, AddressOf EventQueueTick)
    If EventQueueTimerID = 0 Then
        StartEventQueue = False
    Else
        EventQueueRunning = True
        StartEventQueue = True
    End If
End Function

'----------------------------------------------------------
'  Event Queue Stopper
'----------------------------------------------------------
Public Sub StopEventQueue()
    If EventQueueRunning Or EventQueueTimerID > 0 Then
        KillTimer 0, EventQueueTimerID
        EventQueueTimerID = 0
        EventQueueRunning = False
        EventQueueExecuting = False
    End If
End Sub

Private Sub MarkFlooding(Username As String)
    If FloodingUserIndex > FLOODING_USERS_SIZE Then
        FloodingUsers(0) = Username
        FloodingUserIndex = 1
    Else
        FloodingUsers(FloodingUserIndex) = Username
    End If
    If FloodingUserCount <= FLOODING_USERS_SIZE Then _
        FloodingUserCount = FloodingUserCount + 1
End Sub

Private Function CheckFlooding(Username As String) As Boolean
    CheckFlooding = False
    Dim i&
    For i = 0 To (FloodingUserCount - 1)
        If FloodingUsers(i) = Username Then
            CheckFlooding = True
            Exit Function
        End If
    Next i
End Function

Private Sub EventQueueTick(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
On Error GoTo EQT_Error
    Dim i&, j&, IsFlooding As Boolean, PoundPos&
    While EventQueueExecuting
        DoEvents
    Wend
    EventQueueExecuting = True
    
    For i = 0 To (EventQueueSize - 1)
    With EventQueue(i)
        IsFlooding = False
        If Not .Disabled Then
            If aggressiveFiltering Then
                IsFlooding = CheckFlooding(.User)
                If IsFlooding Then Debug.Print .User & " is flooding! (aggressive)"
            End If
            Select Case .eType
                Case ceJoin
                    If useFloodFilter Then
                    For j = (i + 1) To (EventQueueSize - 1)
                        If Not EventQueue(j).Disabled Then
                            If Not IsFlooding Then
                                'Check for flooding.
                                If EventQueue(j).User = .User And _
                                (.RelativeTime + EVENT_FLOOD_THRESHOLD) > _
                                EventQueue(j).RelativeTime And EventQueue(j).eType <> ceUserFlags Then
                                    Debug.Print .User & " is flooding!"
                                    IsFlooding = True
                                    If aggressiveFiltering Then _
                                        MarkFlooding .User
                                    EventQueue(j).Disabled = True
                                End If
                            Else
                                If EventQueue(j).User = .User Then
                                    EventQueue(j).Disabled = True
                                End If
                            End If
                        End If
                    Next j
                    End If
                    If Not IsFlooding Then
                        PoundPos = 0
                        If useMassFilter Then _
                            PoundPos = InStr(.User, "#")
                        If PoundPos > 0 Then
                            If Val(Mid$(.User, PoundPos + 1)) > EVENT_MASS_THRESHOLD Then
                                IsFlooding = True
                                If aggressiveFiltering Then _
                                    MarkFlooding .User
                            End If
                        End If
                        HandleJoin .User, .Client, .Flags, .Ping, IsFlooding
                    End If
                Case ceLeave
                    PoundPos = 0
                    If useMassFilter Then _
                        PoundPos = InStr(.User, "#")
                    If PoundPos > 0 Then
                        If Val(Mid$(.User, PoundPos + 1)) > EVENT_MASS_THRESHOLD Then
                            IsFlooding = True
                            If aggressiveFiltering Then _
                                    MarkFlooding .User
                        End If
                    End If
                    If RemoveChannelUser(frmMain.lvUsers, .User) And Not IsFlooding Then
                        If showJoinLeave Then _
                            AddC .User & " has left the channel.", vbRed
                        If toLog = logAll Or toLog = logChat Then
                            Logger .User & " has left the channel."
                        End If
                    End If
                    If Not (AutoClan Is Nothing) Then
                        AutoClan.UserLeft .User
                    End If
                    'End If
                Case ceWhisperRecv
                    HandleWhisperReceived .User, .Message
                    If toLog = logAll Or toLog = logChat Then _
                        Logger "<From: " & .User & "> " & .Message
                    'If wbEnabled Then WB.WhisperRecv mUser, Text
                Case ceSay
                    PoundPos = 0
                    If useMassFilter Then _
                        PoundPos = InStr(.User, "#")
                    If PoundPos > 0 Then
                        If Val(Mid$(.User, PoundPos + 1)) > EVENT_MASS_THRESHOLD Then
                            IsFlooding = True
                            If aggressiveFiltering Then _
                                    MarkFlooding .User
                        End If
                    End If
                    If Not IsFlooding Then
                        If .Flags And USER_CHANNELOP Then
                            AddC_SCColors "<" & .User & "> ", vbWhite, .Message, vbWhite
                            If toLog = logAll Or toLog = logChat Then _
                                Logger "<" & .User & " (op)> " & .Message
                        Else
                            If usePhrasebans And Bot.HasOps Then _
                                CheckPhrasebans .User, .Message
                            AddC_SCColors "<" & .User & "> ", vbYellow, .Message, vbWhite
                            If toLog = logAll Or toLog = logChat Then _
                                Logger "<" & .User & "> " & .Message
                        End If
                    End If
                Case ceEmote
                    PoundPos = 0
                    If useMassFilter Then _
                        PoundPos = InStr(.User, "#")
                    If PoundPos > 0 Then
                        If Val(Mid$(.User, PoundPos + 1)) > EVENT_MASS_THRESHOLD Then
                            IsFlooding = True
                            If aggressiveFiltering Then _
                                    MarkFlooding .User
                        End If
                    End If
                    If Not IsFlooding Then
                        If .Flags And USER_CHANNELOP Then
                            AddC_SCColors "<" & .User & " ", vbWhite, .Message, vbWhite, ">"
                        Else
                            AddC_SCColors "<" & .User & " ", vbYellow, .Message, vbYellow, ">"
                        End If
                        If toLog = logAll Or toLog = logChat Then _
                            Logger "<" & .User & " " & .Message & ">"
                    End If
                Case ceUserFlags
                    If Not IsFlooding Then
                        UpdateChannelUser frmMain.lvUsers, .User, .Client, .Flags, .Ping
                        If (.Flags And USER_CHANNELOP) Then BotEvent vbNullString, evGetOps, , .User
                    End If
            End Select
        End If
    End With
    Next i
    EventQueueSize = 0
    ReDim EventQueue(EVENT_QUEUE_BASE_SIZE) As CHATEVENT
    EventQueueExecuting = False
    Exit Sub
EQT_Error:
    AddC "Error in event queue: " & Err.Description & " (#" & Err.Number & ").  " & _
        "Please report this bug."
End Sub

Public Sub AddEvent(eType As ChatEventTypes, User As String, Optional ByVal Message _
As String = vbNullString, Optional ByVal Client As bnProduct = bpUnknown, _
Optional ByVal Flags As Long = 0, Optional ByVal Ping As Long = 0)
    Dim UB&, sT As SYSTEMTIME
    While EventQueueExecuting
        DoEvents
    Wend
    EventQueueExecuting = True
    
    UB = UBound(EventQueue)
    If EventQueueSize > UB Then
        ReDim Preserve EventQueue(UB + EVENT_QUEUE_BASE_SIZE) As CHATEVENT
    End If
    GetLocalTime sT
    With EventQueue(EventQueueSize)
        .eType = eType
        .User = User
        .Message = Message
        .Flags = Flags
        .Ping = Ping
        .Client = Client
        .RelativeTime = GetTickCount()
        .Time = sT
        .Disabled = False
    End With
    EventQueueSize = EventQueueSize + 1
    EventQueueExecuting = False
End Sub


'Private Sub QueueTick(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
'    Dim Delay&
'    If qSize = 0 Then Exit Sub
'    If LastLen <= 4 Then
'        Delay = 1750
'    ElseIf LastLen > 4 And LastLen <= 15 Then
'        Delay = 2150
'    ElseIf LastLen > 15 And LastLen <= 25 Then
'        Delay = 2750
'    Else
'        Delay = 3250
'    End If
'    If (LastSend + Delay) <= dwTime Then
'        qSendNext dwTime
'    End If
'End Sub

Public Sub QueueNotifyProc(ByVal QueueID As Long, ByVal MessageLength As Long, ByVal Priority As Long)
    Dim Message As String, Res As Long
    
    Message = String$(MessageLength + 1, vbNullChar)
    Res = myriad_queue_get(QueueID, Message, MessageLength + 1)
    If (Res = 0) Then
        Exit Sub
    ElseIf (Res <= MessageLength) Then
        If Right$(Message, 1) = vbNullChar Then _
            Message = Left$(Message, MessageLength)
        Bot.Say Message
    Else
        Message = String$(Res + 1, vbNullChar)
        Res = myriad_queue_get(QueueID, Message, Res + 1)
        If Right$(Message, 1) = vbNullChar Then _
            Message = Left$(Message, Res)
        Bot.Say Message
    End If
End Sub

Public Function IsQueueBusy() As Boolean
    If myriad_queue_size(QueueID) >= QUEUE_BUSY_THRESHOLD Then
        IsQueueBusy = True
    Else
        IsQueueBusy = False
    End If
End Function

Public Sub qAdd(ByVal Message As String, Optional ByVal Priority As Long = 2)
    myriad_queue_enqueue QueueID, Message, Priority
End Sub

Public Sub qDel(Optional ByVal Index As Long = 1)
    'qSize = qSize - 1
    'qData.Remove Index
End Sub

Public Sub qStart()
    QueueID = myriad_queue_create(AddressOf QueueNotifyProc, 1)
    If (QueueID = -1) Then
        LogEvent "Failed to start queue system!", etAlwaysError
    End If
End Sub

Public Sub qStop()
    If QueueID <> -1 Then _
        myriad_queue_destroy QueueID
End Sub

Public Sub qClear()
    If QueueID <> -1 Then _
        myriad_queue_clear QueueID
End Sub

'Send Logic:
'If (LastTick + Delay) <= Now

'Delay Logic:
'

'Private Function RequiredDelay(ByVal Bytes As Long) As Long
'    Dim Tick&
'    Const PerPacket = 200
'    Const PerByte = 10
'    Const MaxBytes = 600
'   Tick = GetTickCount()
'    'If difference between now and our last-sent message
'    'is greater than the required delay based on the length
'    'of the last-sent message...
'    If (Tick - LastSend) > (LastLen * PerByte) Then
'        '... set last message length to 0.
'        LastLen = 0
'    'Otherwise...
'    Else
'        '... subtract the number of bytes that the current
'        'delay has covered.
'        LastLen = LastLen - ((Tick - LastSend) * PerByte)
'    End If
'
'
'End Function

'*******************************************************************
' If this returns non-zero, delay that many milliseconds
'  before trying again. If this returns zero, send your data.
'*******************************************************************
'Private Function RequiredDelay(ByVal Bytes As Long) As Long
'    Static LastTick As Long
'    Static SentBytes As Long
'    Const PerPacket = 200
'    Const PerByte = 10
'    Const MaxBytes = 600
'    Dim Tick As Long
'    Tick = GetTickCount()
'    If (Tick - LastTick) > (SentBytes * PerByte) Then
'        SentBytes = 0
'    Else
'        SentBytes = SentBytes - (Tick - LastTick) / PerByte
'    End If
'    LastTick = Tick
'    If (SentBytes + PerPacket + Bytes) > MaxBytes Then
'        RequiredDelay = (SentBytes + PerPacket + Bytes - MaxBytes) * PerByte
'    Else
'        SentBytes = SentBytes + PerPacket + Bytes
'        RequiredDelay = 0
'    End If
'End Function

'Private Sub QueueSend(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
'    Dim myMessage$, msDelay&
'    myMessage = NextQueueMessage()
'    If LenB(myMessage) = 0 Then
'        KillTimer 0, mTimerId
'        Exit Sub
'    End If
'    msDelay = RequiredDelay(Len(myMessage))
'    If msDelay = 0 Then
'        Bot.Say myMessage
'    Else
'        mTimerId = SetTimer(0, 0, msDelay, AddressOf QueueSend)
'       'mTimerId = CreateTimer(RequiredDelay, AddressOf QueueSend)
'    End If
'End Sub

'Private Sub QueueSendEmpty(ByVal Message As String)
'    Dim msDelay&
'    msDelay = RequiredDelay(Len(Message))
'    If msDelay = 0 Then
'        Bot.Say Message
'    Else
'
'End Sub
