Code: Select all
;------------------------------------------------------
;- HiSpeed WordCounter for Purebasic 4.0
;-
;- Written by comtois (2004), enhanced by flype (2006)
;------------------------------------------------------
EnableExplicit
Macro EnableGadgetRedraw(gadget, bool)
SendMessage_(GadgetID(gadget), #WM_SETREDRAW, bool, #Null)
EndMacro
Structure NODE
s.s ; word
n.i ; counter
*l.NODE ; left node
*r.NODE ; right node
EndStructure
Procedure Node(*node.NODE, word.s)
If *node
If word = *node\s
*node\n + 1
ElseIf word < *node\s
*node\l = Node(*node\l, word)
Else
*node\r = Node(*node\r, word)
EndIf
Else
*node = AllocateMemory(SizeOf(NODE))
If *node
*node\s = word
*node\n = 1
EndIf
EndIf
ProcedureReturn *node
EndProcedure
Procedure.s FileToString(fichier.s)
Protected texte.s
If ReadFile(0, fichier)
texte = Space(Lof(0))
ReadData(0, @texte, Lof(0))
CloseFile(0)
EndIf
ProcedureReturn texte
EndProcedure
Procedure Process(string.s, minimum)
Protected *node, word.s, length, *str.Byte = @string
While *str\b
Select *str\b
Case ' ', '.', ',', ';', ' ', '(', ')', '[', ']', '"', ':', '=', '^', 39, #TAB, #CR, #LF
If length >= minimum
*node = Node(*node, word)
EndIf
word = ""
length = 0
Default
word + Chr(*str\b)
length + 1
EndSelect
*str + 1
Wend
ProcedureReturn *node
EndProcedure
Procedure.s NodesToString(*node.NODE, minimum)
Protected result.s
If *node
result + NodesToString(*node\l, minimum)
If *node\n >= minimum
result + RSet(Str(*node\n), 3, "0") + " : " + *node\s + #CRLF$
EndIf
result + NodesToString(*node\r, minimum)
EndIf
ProcedureReturn result
EndProcedure
Procedure.s NodesToList(*node.NODE, List myList.NODE())
If *node
NodesToList(*node\l, myList())
If AddElement(myList())
myList()\s = *node\s
myList()\n = *node\n
EndIf
NodesToList(*node\r, myList())
EndIf
EndProcedure
Procedure.s NodesToListIcon(*node.NODE, minimum)
If *node
NodesToListIcon(*node\l, minimum)
If *node\n >= minimum
AddGadgetItem(0, -1, *node\s + #LF$ + Str(*node\n))
EndIf
NodesToListIcon(*node\r, minimum)
EndIf
EndProcedure
;------------------------------------------------------
;- TEST
;------------------------------------------------------
#EXAMPLE = 3
Define WordLength = 1
Define WordCount = 1
;Define.s WordFileName = #PB_Compiler_Home + "Compilers/PBFunctionListing.txt"
Define.s WordFileName = #PB_Compiler_Home + "Compilers/APIFunctionListing.txt"
Select #EXAMPLE
Case 1 ; Nodes To String
If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered)
EditorGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10)
EnableGadgetRedraw(0, #False)
SetGadgetText(0, NodesToString(Process(FileToString(WordFileName), WordLength), WordCount))
EnableGadgetRedraw(0, #True)
HideWindow(0, #False)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
Case 2 ; Nodes To ListIconGadget
If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered)
ListIconGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, "Word", 250, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(0, 1, "Count", WindowWidth(0)-290)
EnableGadgetRedraw(0, #False)
NodesToListIcon(Process(FileToString(WordFileName), WordLength), WordCount)
EnableGadgetRedraw(0, #True)
HideWindow(0, #False)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
Case 3 ; Nodes To List To ListIconGadget
If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered)
ListIconGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, "Word", 250, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(0, 1, "Count", WindowWidth(0)-290)
EnableGadgetRedraw(0, #False)
NewList SortedList.NODE()
NodesToList(Process(FileToString(WordFileName), WordLength), SortedList())
SortStructuredList(SortedList(), 1, OffsetOf(NODE\n), #PB_Long)
ForEach SortedList()
AddGadgetItem(0, -1, SortedList()\s + #LF$ + Str(SortedList()\n))
Next
EnableGadgetRedraw(0, #True)
HideWindow(0, #False)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
EndSelect
;------------------------------------------------------