' #Filename "testArraySort.tBASIC"
' #Author "René"
' #Date "2015-12-20"
Uses "Console", "File"
Type tProfile
FunctionName As String
NumberOfCalls As Number
UsedTime As Number
End Type
' --------------------------------------------------------------------------------
Function TBMain()
' --------------------------------------------------------------------------------
Local sLine(), sPart() As String
Local i, nLines As Long
Local Trace() As tProfile
' load tracefile and parse it
nLines = Parse( File Tracefilename, sLine, $CRLF )
' either replace Tracefilename with a valid filename
' or save this script into a directory that contains "*Trace*.csv"-files
If nLines < 2 Then
PrintL "no Trace-file found"
WaitKey
Stop
EndIf
PrintL "have " & nLines & " lines"
Array Sort sLine, Descend ' bring empty elements to the end
While StrPtrLen(StrPtr(sLine(UBound(sLine)))) = 0
' kill empty elements
nLines -= 1
ReDim Preserve sLine(nLines)
Wend
PrintL "now have " & nLines & " lines"
ReDim Trace(nLines)
' fill data into udt now:
For i = 1 To nLines
ReDim sPart(1)
If Parse(sLine(i), sPart, ";") = 3 Then
Trace(i).FunctionName = sPart(1)
Trace(i).NumberOfCalls = Val(sPart(2))
Trace(i).UsedTime = Val(sPart(3))
EndIf
Next
PrintL "data filled in " & UBound(trace) & " elements"
PrintL
PrintL "any key to sort by used time now"
WaitKey
' now sort Array of tProfile by udt_element(tProfile.UsedTime):
If Array_Sort_Type( Trace, "tProfile", "Number", UDT_ElementOffset(Trace(1).UsedTime)) Then Nop
' need use "If" to request a function result
' because of dynamic variables within Array_Sort_Type()
For i = 1 To UBound(Trace)
PrintL Trace(i).UsedTime, Trace(i).FunctionName, Trace(i).NumberOfCalls
Next
PrintL
PrintL "any key to sort by number of calls now"
WaitKey
' sort Array of tProfile by udt_element(tProfile.NumberOfCalls):
If Array_Sort_Type( Trace, "tProfile", "Number", UDT_ElementOffset(Trace(1).NumberOfCalls)) Then Nop
For i = 1 To UBound(Trace)
PrintL Trace(i).NumberOfCalls, Trace(i).FunctionName, Trace(i).UsedTime
Next
PrintL
PrintL "any key to end"
WaitKey
End Function
' -----------------------------------------------------------------
Function Array_Sort_Type( ByRef a() As Byte, _
ByVal TypeOfUDT As String, _
ByVal TypeOfSubset As String, _
ByVal lSubOffset As Long, _
Optional ByVal lDirection As Long = 1 _
) As Boolean
' -----------------------------------------------------------------
Local lCount, lIndex As Long
Local sElement As String
Local realArray(UBound(a)) Like TypeOfUDT At VarPtr(a(1))
Local lNum1 Like TypeOfSubset At 0
Local lNum2 Like TypeOfSubset At 0
If UBound(a) < 2 Then Exit Function
If lDirection < 0 Then
' descend
Select Case Ucase$(TypeOfSubset)
Case "STRING"
' not implemented for strings
Case Else
For lCount = 2 To UBound(a)
sElement = Memory_Get(VarPtr(realArray(lCount)), SizeOf(realArray(1)))
lIndex = lCount
SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
SetAt( lNum2, StrPtr(sElement) + lSubOffset )
While lNum1 < lNum2
Memory_Set(VarPtr(realArray(lIndex)), Memory_Get(VarPtr(realArray(lIndex-1)), SizeOf(realArray(1))))
lIndex -= 1
If lIndex = 1 Then Exit While
SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
Wend
Memory_Set(VarPtr(realArray(lIndex)), sElement)
Next
End Select
Else
' ascend
Select Case Ucase$(TypeOfSubset)
Case "STRING"
' not implemented for strings
Case Else
For lCount = 2 To UBound(a)
sElement = Memory_Get(VarPtr(realArray(lCount)), SizeOf(realArray(1)))
lIndex = lCount
SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
SetAt( lNum2, StrPtr(sElement) + lSubOffset )
While lNum1 > lNum2
Memory_Set(VarPtr(realArray(lIndex)), Memory_Get(VarPtr(realArray(lIndex-1)), SizeOf(realArray(1))))
lIndex -= 1
If lIndex = 1 Then Exit While
SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
Wend
Memory_Set(VarPtr(realArray(lIndex)), sElement)
Next
End Select
EndIf
Function = TRUE
End Function
' --------------------------------------------------------------------------------
Function TraceFilename() As String
' --------------------------------------------------------------------------------
' seems Load_File does not accept wildcards...
Local sFile(), sPrompt As String
Local i, nFiles, slctd As Long
nFiles = DIR_ListArray(sFile, APP_ScriptPath, "*Trace*.csv", %FILE_NORMAL)
Select Case nFiles
Case 0
Return ""
Case 1
Return sFile(1)
End Select
For i = 1 To nFiles
sPrompt &= "[" & TStr$(i) & "] " & sFile(i) & $CRLF
Next
slctd = Val( InputBox$(sPrompt ,"Please select a file-number", "1") )
If Not Between(slctd, 1, nFiles) Then
Function = ""
Else
Function = sFile(slctd)
EndIf
End Function
Bookmarks