' The QSort class sorts arrays using the quicksort algorithm.
' This code is a derived work from the code found at:
' http://4guysfromrolla.com/webtech/012799-2.shtml
' This version can sort arrays of values or objects, using a user-supplied
' comparison function.

Public Const CMP_LESS = -1
Public Const CMP_EQU = 0
Public Const CMP_GREATER = 1

Public Const ORDER_ASC = 1
Public Const ORDER_DESC = -1

Function Qsort_cmp(a, b)
  If a < b Then
    Qsort_cmp = CMP_LESS
  ElseIf a > b Then
    Qsort_cmp = CMP_GREATER
  Else
    Qsort_cmp = CMP_EQU
  End If
End Function

Function Array_swap(values, i, j)
  Dim temp: temp = values(i)
  values(i) = values(j)
  values(j) = temp
End Function

Function Array_swapO(values, i, j)
  Dim temp: Set temp = values(i)
  Set values(i) = values(j)
  Set values(j) = temp
End Function

Class QSort
  Private f_order
  Private f_cmp
  Private f_swap
  Private valueSort
  Private reset_cmp
  
  Private Sub class_initialize()
    f_order = ORDER_ASC
    reset_cmp = False
  End Sub
  
  ' Compare a and b, taking the sort-order into account
  ' If DESC, reverse the results of the comparison
  Private Function Comp(a, b)
    Comp = f_cmp(a, b) * f_order
  End Function
  
  Private Sub QSort(ByRef values, loBound, hiBound)
    Dim pivot, loSwap, hiSwap
  
    ' Two items to sort
    If hiBound - loBound = 1 Then
      If Comp(values(loBound), values(hiBound)) = CMP_GREATER Then
        f_swap values, loBound, hiBound
      End If
      Exit Sub
    End If
  
    ' Three or more items to sort
    Dim pivotIndex: pivotIndex = Int((loBound + hiBound) / 2)
  
    If valueSort Then
      pivot = values(pivotIndex)
    Else
      Set pivot = values(pivotIndex)
    End If
  
    f_swap values, pivotIndex, loBound
  
    loSwap = loBound + 1
    hiSwap = hiBound
  
    Do
      ' Find the right loSwap
      While (loSwap < hiSwap) And (Comp(values(loSwap), pivot) <> CMP_GREATER)
        loSwap = loSwap + 1
      Wend
      ' Find the right hiSwap
      While (Comp(values(hiSwap), pivot) = CMP_GREATER)
        hiSwap = hiSwap - 1
      Wend
      ' Swap values if loSwap is less then hiSwap
      If loSwap < hiSwap Then
        f_swap values, loSwap, hiSwap
      End If
    Loop While loSwap < hiSwap
  
    If valueSort Then
      values(loBound) = values(hiSwap)
      values(hiSwap) = pivot
    Else
      Set values(loBound) = values(hiSwap)
      Set values(hiSwap) = pivot
    End If
  
    ' Recurse:
    ' 2 or more items in first section
    If loBound < hiSwap - 1 Then QSort values, loBound, hiSwap - 1
    ' 2 or more items in second section
    If hiSwap + 1 < hiBound Then QSort values, hiSwap + 1, hiBound
  End Sub
  
  Public Property Set Compare(func)
    Set f_cmp = func
  End Property
  
  Public Property Let Order(sortOrder)
    f_order = sortOrder
  End Property
  
  Private Sub DetermineComparisonType(ByRef values)
    If IsEmpty(f_cmp) Then
      valueSort = True
      reset_cmp = True
      Set f_cmp = GetRef("Qsort_cmp")
      Set f_swap = GetRef("Array_swap")
    ElseIf IsObject(values(LBound(values))) Then
      ' User defined object sorting
      valueSort = False
      Set f_swap = GetRef("Array_swap0")
    Else
      ' User defined value sorting
      valueSort = True
      Set f_swap = GetRef("Array_swap")
    End If
  End Sub
  
  Public Sub Sort(ByRef values)
  ' Don't sort empty arrays or arrays with only 1 value
    If UBound(values) < 1 Then Exit Sub
  
    DetermineComparisonType values
    QSort values, LBound(values), UBound(values)
  
    If reset_cmp Then f_cmp = Empty
  End Sub
  
  Public Function Sorter(values)
    Sort values
    Sorter = values
  End Function
End Class