This .bi File manage hash lists with a nice Basic like syntax wich is very easy to use.
There also is a "GarbageCollector" wich is in fact a very simple interface for helping with memory managment : listnodes hierarchy can be broken using the AllFlat property, and then listnodes are "softdeleted" so that they can be automatically re-used instead using cAllocate.
The same instance of List object can be manipulate either as a flat or as a hashed list, depending what you are expecting.
Thus, the ListTag is an array (define by a constant) where you can directly store values in relation with the listnode : not the best code ever but usefull enought to optimise your algorythms.
For Flat lists use :
Liste.Tag(key) : to create a new entry or set position to the node identified by key
Liste.BlindTag(key) : add a new entry at end of list
Liste.HasTag(Key) : return 1 or 0, does not change current entry, but do it fast if Liste.Tag(key) is used on same key, ex :
If MaListe.HasTag(Key)=1 Then : MaListe.Tag(Key)
Else : .. 'continuing parsing list
End If
For parsing as a flat list :
For i=1 To MaListe.AllOf : MaListe.BlindStep
'Code here
Next i
For hash lists use :
Liste.HashTag(key) : to create a new entry or set position to the node identified by key, return 1 if key already exists
Liste.HasHashTag(Key) : return 1 or 0, doesn't create a new entry, just return information
exemples :
If MaListe.HashTag(key)=1 Then
'Code for managing existing values
Else
'Code for managing new value, entry already created (just one parse)
End If
For parsing as a hash list : (equiv For Each)
MaListe.Root
While MaListe.HashStep=1
Print 'Tag=' & MaListe.Tag & ' - StringValue=' & MaListe.Val
'Code here
Wend
You can also set tag cursor with Coltags and store additionnal values with RwTag, ex
MaListe.ColTag(1) : MaListe.RwTag('test') ' store "test" in current tag at ind 1
MaListe.ColTag(0) ' don't forget to reset the index on index col
MaListe.ColTag(1) : MaListe.Tag ' return 'test'
The exemple below show how the simplified memory managment with the "GarbageCollector" (sic) operates
You can un-comment print '*New' and print '*Vralloc' in AllowCake property in .bi file to see more details
Code: Select all
#Include once "LZListsEngine.bi"
Dim MaListe as List
Dim i As Integer
MaListe.HashTag("12")
MaListe.HashTag("123")
MaListe.HashTag("124")
MaListe.HashTag("1235")
MaListe.HashTag("8")
MaListe.HashTag("2")
MaListe.HashTag("3")
MaListe.HashTag("37")
MaListe.HashTag("39")
MaListe.root
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
MaListe.root :
Print "Tag racine root = " & Maliste.Tag
Maliste.BlindStep
Print "Tag racine 1er = " & Maliste.Tag
MaListe.Last : Print "Last = " &Maliste.hashTag
MaListe.LastLast : Print "LastLast = " &Maliste.hashTag
Print "---------------"
Print "Root - Flat - Root 001"
MaListe.root
Maliste.AllFlat
For i=1 To Maliste.AllOf
Print str(i) & " - " & Maliste.Tag
Maliste.BlindStep
Next i
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
MaListe.root :
Print "Tag racine root = " & Maliste.Tag
Maliste.BlindStep : Print "Tag racine 1er = " & Maliste.Tag
MaListe.Last : Print "Last = " &Maliste.Tag
MaListe.LastLast : Print "LastLast = " &Maliste.Tag
Print
Print "GarbageCollector"
MaListe.GarbageCollector
For i=1 To Maliste.AllOf
Print str(i) & " - " & Maliste.Tag
Maliste.BlindStep
Next i
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
MaListe.root :
Print "Tag racine root = " & Maliste.Tag
Maliste.BlindStep : Print "Tag racine 1er = " & Maliste.Tag
MaListe.Last : Print "Last = " &Maliste.Tag
MaListe.LastLast : Print "LastLast = " &Maliste.Tag
Print
Print "---------------"
MaListe.root
Print "Vralloc test 01"
MaListe.HashTag("12")
MaListe.HashTag("123")
MaListe.HashTag("124")
MaListe.HashTag("1235")
MaListe.HashTag("2")
MaListe.HashTag("3")
MaListe.HashTag("37")
MaListe.HashTag("39")
Print
MaListe.root
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Maliste.BlindStep : Print "Tag racine 1er = " & Maliste.Tag
MaListe.Last : Print "Last = " &Maliste.Tag
MaListe.LastLast : Print "LastLast = " &Maliste.Tag
Print "---------------"
MaListe.Root
For i=0 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
sleep
Print "---------------HASH STEP---------------"
MaListe.root
Maliste.AllOf
While Maliste.HashStep=1
Print Maliste.hashTag
Wend
MaListe.root
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Maliste.BlindStep : Print "Tag racine 1er = " & Maliste.Tag
MaListe.Last : Print "Last = " &Maliste.Tag
MaListe.LastLast : Print "LastLast = " &Maliste.Tag
Print "---------------test"
MaListe.Root
For i=0 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
Print
Print "fin Vralloc 01"
sleep
Print "---------------"
Print "Root - Flat - Root 002"
MaListe.root
Maliste.AllOf
Maliste.AllFlat
Print "---------------test"
MaListe.Root
For i=0 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
Print
Print "fin Vralloc 01"
sleep
Print "GarbageCollector 2"
MaListe.GarbageCollector
For i=1 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
MaListe.root :
Print "Tag racine root = " & Maliste.Tag
Maliste.BlindStep : Print "Tag racine 1er = " & Maliste.Tag
MaListe.Last : Print "Last = " &Maliste.Tag
MaListe.LastLast : Print "LastLast = " &Maliste.Tag
Print "GarbageCollector"
sleep
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Print "->"
sleep
Print "Vralloc test 2"
MaListe.HashTag("12")
MaListe.HashTag("123")
MaListe.HashTag("124")
MaListe.HashTag("1235")
MaListe.HashTag("8")
MaListe.HashTag("2")
MaListe.HashTag("3")
MaListe.HashTag("37")
MaListe.HashTag("319")
Print "Tag racine root = " & Maliste.Tag
Maliste.BlindStep
Print "Tag racine 1er = " & Maliste.Tag
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Print "******************************************"
sleep
MaListe.root
While Maliste.HashStep=1
Print Maliste.hashTag
Wend
Maliste.BlindStep
Print "* vralloc Dernier 2 = " & Maliste.Tag
Print "Root - Flat - root"
MaListe.root
Maliste.AllFlat
MaListe.root
sleep
Print "---------------"
Print "GarbageCollector 3"
MaListe.GarbageCollector
For i=1 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Print "->"
sleep
Print "Vralloc test 3"
MaListe.HashTag("12")
MaListe.HashTag("123")
MaListe.HashTag("124")
MaListe.HashTag("1235")
MaListe.HashTag("8")
MaListe.HashTag("2")
MaListe.HashTag("3")
MaListe.HashTag("37")
MaListe.HashTag("39")
MaListe.root :
Print "Tag racine root = " & Maliste.Tag
Maliste.BlindStep
Print "Tag racine 1er = " & Maliste.Tag
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
sleep
MaListe.root
While Maliste.HashStep=1
Print Maliste.hashTag
Wend
Maliste.BlindStep
Print "* vralloc Dernier 3 = " & Maliste.Tag
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
MaListe.HashTag("8")
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
sleep
MaListe.Root
Print "Debut"
While Maliste.HashStep=1
Print "#" & Maliste.hashTag
Wend
MaListe.Root
Print "** Allof=" & str(Maliste.AllOf) :sleep
For i=1 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
Print "**"
sleep
MaListe.HashTag("12")
MaListe.HashTag("123")
MaListe.HashTag("124")
MaListe.HashTag("1235")
MaListe.HashTag("8")
MaListe.HashTag("2")
MaListe.HashTag("3")
MaListe.HashTag("37")
MaListe.HashTag("39")
MaListe.Root
Print "Allof=" & str(Maliste.AllOf) :sleep
For i=1 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
Print "--"
sleep
Print "----------"
MaListe.root
Print "*2"
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Sleep
MaListe.root
While Maliste.HashStep=1
Print Maliste.hashTag
Wend
MaListe.root
MaListe.HashTag("123")
MaListe.HashTag("124")
MaListe.HashTag("1235")
MaListe.HashTag("2")
MaListe.HashTag("3")
MaListe.HashTag("31")
Print "AllOf = " & Maliste.AllOf
Print "%HashCount = " & Maliste.HashCount
MaListe.root
Maliste.AllOf
While Maliste.HashStep=1
Print Maliste.hashTag
Wend
Sleep
MaListe.root
Print "AllOf = " & Maliste.AllOf
Print "%%HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
sleep
Print "Root - Flat - root"
MaListe.root
Maliste.AllFlat
MaListe.root
Print "---------------"
Print "GarbageCollector 4"
MaListe.GarbageCollector
For i=0 To Maliste.AllOf : Maliste.BlindStep
Print str(i) & " - " & Maliste.Tag
Next i
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Print "okok ->"
sleep
Print "Vralloc test 4"
MaListe.HashTag("13")
MaListe.HashTag("134")
MaListe.HashTag("1335")
MaListe.HashTag("2")
MaListe.HashTag("3")
MaListe.HashTag("37")
MaListe.HashTag("39")
MaListe.root :
Print "Tag racine root = " & Maliste.Tag
Maliste.BlindStep
Print "Tag racine 1er = " & Maliste.Tag
Print "AllOf = " & Maliste.AllOf
Print "HashCount = " & Maliste.HashCount
sleep
MaListe.root
While Maliste.HashStep=1
Print Maliste.hashTag
Wend
Maliste.BlindStep
Print "* vralloc Dernier 3 = " & Maliste.Tag
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Print "Garbage count = " & Str(Maliste.GarbageCt)
sleep
Print "Nb tot nodes = " & Str(MaListe.NodeCount)
Print Str(MaListe.DropAll) & " nodes deallocated"
sleep
Code: Select all
CONST MAX_TAKE = 4
CONST MAX_COLS = 5 ' Le nombre maximal de clefs pouvant être utilisées sur la MEME liste start=0
CONST LIST_RES = Chr(18) ' "Reserved" 'Chr(168) 'Chr(8) '
CONST LIST_DEL = Chr(3) ' "~"
Type ListContainer 'Data Segment Level : can help for bigger strings
Dim str_item as String
Declare Constructor()
Public:
Declare Property sData(ByVal Str_Data As String)
Declare Property sData() As String
End Type
Property ListContainer.sData(ByVal Str_Data as String) : this.str_item = Str_Data : End Property
Property ListContainer.sData() as String : Return this.str_item : End Property
Constructor ListContainer() : str_item = "" : End Constructor
Type listnode 'ListNode Level
Dim Tag(0 to MAX_COLS-1) As String ' La clef
Dim ListData As ListContainer
Dim pNext As listnode Ptr
Dim pPrev As listnode Ptr
Dim pIndex As listnode Ptr
Dim pBranch As listnode Ptr
Dim pBranchLastNode As listnode Ptr
Dim BranchCount As UlongInt=0
End Type
Type ListContext 'Branch context Level
Dim pNode As listnode Ptr
Dim pFirstNode As listnode Ptr
Dim pLastNode As listnode Ptr
Dim pBranchLastNode As listnode Ptr
Dim BranchCount As UlongInt=0
Dim uCount As UlongInt
Dim bSearchRes As Byte
End Type
Type List
Declare Constructor()
Declare Destructor()
Private:
Dim pNode As listnode Ptr
Dim pFirstNode As listnode Ptr
Dim pLastNode As listnode Ptr
Dim pFirstFIRSTNode As listnode Ptr
Dim pLastLASTNode As listnode Ptr
Dim pSearchNode As listnode Ptr
Dim pWrkngNode(0 to MAX_TAKE-1) As listnode Ptr
Dim sSearchTag As String
Dim sWrkngTag(0 to MAX_TAKE-1) As String
Dim bSearchRes As Byte
Dim bSeekMethod As Byte
Dim uTag as Ubyte=0
Dim bStepCheck As Byte = 0
Dim uCount As UlongInt
Dim uCountCOUNT As UlongInt
Dim uHashCOUNT As UlongInt
Dim uHashDeleted As UlongInt = 0
Dim uNodeCOUNT As UlongInt = 0
Dim GarbageCOUNT As UlongInt = 0
Dim FlatCOUNT As UlongInt = 0
Dim bHashLen As Byte = 1
Dim VrallocSuccess As Byte=0
Dim sHashTag As String
Declare Property AllowCake() As listnode Ptr
Declare Property Flat() As Byte
Declare Property VrAlloc() As ListNode Ptr
Declare Property HashDestroy() As Byte ' Suppression logique et mise en corbeille un seul node ds un arbre
Declare Property NewHash(pSourceNode As ListNode Ptr) As Byte
Declare Property Branch() As listnode Ptr '
Declare Property UpLevel() As Byte ' Revient à la liste parente
Public:
'Flat control
Declare Property Tag(str_Tag As String) As listnode Ptr ' Create a new ListNode with Key=str_Tag OR retrieve position of an existing Tag
Declare Property Tag() As String ' Return current Tag value in a list =Tag(0)
Declare Property Tag(iTag As Integer) As String ' Return current Tag value of the specified entry in array
Declare Property HasTag(str_Tag As String) As Byte ' Create a Hash List or sublist for Key=str_Tag
Declare Property BlindTag(str_Tag As String) As listnode Ptr ' Create a new ListNode with Key=str_Tag at end of the list
Declare Property RwTag(s_Tag As String) As listnode Ptr ' Rewrite Tag Value of current Node : if current node is Hashed, just rewrite HashTag Value not effective Key value
Declare Property ColTags() As Byte ' Renvoie le numéro de la colonne de tag active
Declare Property ColTags(i as Byte) As Byte ' Définie la colonne de tag active de 0 à MAX_COLS, par défaut 0
Declare Property UniqueTags(i as Byte) As Byte
Declare Property AllOf() As UlongInt ' Return number of node in root list or branch list, set position to the first node for flat parse
Declare Property Count() As UlongInt ' =AllOf but doesn't change current node
Declare Property First() As listnode Ptr 'Set current node to first node considering flat list (root or branch)
Declare Property Last() As listnode Ptr 'Set current node to Last node considering flat list (root or branch)
Declare Property LastLast() As listnode Ptr
Declare Property Val(str_value As String) As listnode Ptr ' Assign a string (+50 len) to the current node that is identified by a Tag
Declare Property Val() As String ' Return current node string datas
Declare Property ValTag(str_value As String) As String ' Considering current Flat list (root or branch as a flat list) return string data identified by Key=str_Tag
'Flat control : jump
Declare Property BlindStep() As listnode Ptr ' Jump to next node
Declare Property BlindStep(i As LongInt) As listnode Ptr ' Equivalent to a Seek on a list but position is relative - List.First : List.BlindStep(i)
Declare Property Bsm(i As Byte) As Byte 'BlindStep method 0=fastest 1=no crash
'Flat control : memorise a handle on a listnode
Declare Property Aside() As listnode Ptr ' Memorise listnode ptr dans le pointeur n°0
Declare Property Aside(i As ulong) As listnode Ptr ' Memorise listnode ptr dans le pointeur n°i
Declare Property Recover() As listnode Ptr ' Repositionne l'élément courant de la liste sur celui mémorisé par Take, si cet élément existe toujours, sinon renvoie False
Declare Property Recover(i As ulong) As listnode Ptr ' Repositionne l'élément courant de la liste sur celui mémorisé par Take(i)
'Mem purge
Declare Property Drop() As listnode Ptr
Declare Property HashDropAll As List
Declare Property DropAll As ULongInt 'Remove all elements in list
Declare Property Exdim As List 'Idem Exdim returning a new list wich is list passed by ref
Declare Property NewRoot() As Ubyte
'Hash control handling
Declare Property Root() As Byte ' Set cursor to first root node
Declare Property HashStep() As Byte ' FOR EACH - recursive parse property
Declare Property HashTag(str_Tag As String) As Byte ' Build a hash Key on str_Tag, Return 1 if already exits otherwise return 0
Declare Property HashTag() As String ' Return Hash key value of current node
Declare Property HasHashTag(str_Tag As String) As Byte ' Return 1 if str_Tag is a hash key otherwise return 0
Declare Property HashLen(bHashLen As Byte) As Byte ' Longueur du hachage
Declare Property HashCount() As uLongInt ' number of hash key tracking
Declare Property AllFlat() As Byte 'Destroy a hash hierarchical list to a flat list
Declare Property BranchFlat() As Byte 'Destroy a part of a hash list to a flat list
Declare Property GarbageCollector() As ULongInt 'All nodes marked for deletion by AllFlat or BranchFlat that are "flated" to root are marked for being dynamically re-used by Vralloc property wich intercept cAllocate calls
Declare Property GarbageCt() As UlongInt
Declare Property NodeCount() As UlongInt
End Type
'TYPE LIST PRIVATE PROPERTIES
Property List.AllowCake() As listnode Ptr
Dim pTemp As listnode Ptr : pTemp = This.Vralloc()
If pTemp = 0 Then : pTemp = CAllocate(Len(listnode)) : this.uNodeCOUNT +=1 : this.pLastLASTNode = pTemp ' : print "*New" ' Moment Angulaire(petite masse)
Else : This.GarbageCOUNT-=1 : this.pLastLASTNode = pTemp ' : print "*Vralloc" ' L'univers est fini
End If : Return pTemp
End Property
Property List.Flat() As Byte
Dim pTmp1 as listnode Ptr : Dim pTestLast as listnode Ptr : Dim uFlatCount As uLongInt=1 : Dim pTmp2 as listnode Ptr
this.VrallocSuccess=1
pTmp1= this.pFirstNode->pNext
Do
This.HashDestroy : pTmp1= this.pNode : this.pNode=this.pNode->pNext : uFlatCount+=1
If pTmp1->Tag(MAX_COLS-1) <>"*" Then : pTmp1->Tag(MAX_COLS-1) = LIST_DEL : End If
Loop Until pTmp1->pNext=0 Or pTmp1=this.pLastLASTNode
this.uCount=uFlatCount
this.pLastNode=this.pLastLASTNode
If this.pnode=this.pLastLASTNode Then : this.pnode->pNext=0 : End If
this.pnode=this.pFirstFIRSTNode
Return 0
End Property
Property List.VrAlloc() As ListNode Ptr
If this.VrallocSuccess=0 Then : Return 0 : End If
Dim pContext As ListContext : Dim iLong As UlongInt : Dim zLong As UlongInt=0 : Dim pTmp1 as listnode Ptr : Dim pTmp2 as listnode Ptr
If This.pNode=0 AndAlso This.pFirstNode=0 And This.pFirstFirstNode=0 Then : Return 0 : End If
pContext.pNode = This.pNode : pContext.pFirstNode = This.pFirstNode : pContext.pLastNode = This.pLastNode
pContext.uCount = This.uCount : pContext.bSearchRes = This.bSearchRes : pTmp1 = This.pFirstNode->pBranch
If pTmp1 <> 0 Then : pContext.pBranchLastNode = pTmp1->pBranchLastNode : pContext.BranchCount = pTmp1->BranchCount : End If
This.Root
This.uCount = CuLngInt(this.pFirstNode->BranchCount)
pTmp2 = This.pNode->pNext
If This.AllOf>0 Then
For iLong=1 To This.AllOf
If pTmp2->Tag(uTag) = LIST_DEL And pTmp2->pNext<>0 Then
this.uHashCount -=1
pTmp2->pPrev->pNext=pTmp2->pNext
pTmp2->pNext->pPrev=pTmp2->pPrev
pTmp2->pPrev=0 : pTmp2->pNext=0 : pTmp2->pIndex = 0 : pTmp2->pBranch=0 : pTmp2->pBranchLastNode=0 : pTmp2->BranchCount=0
pTmp2->pBranchLastNode=0 : pTmp2->BranchCount=0
pTmp2->Tag(MAX_COLS-1) = ""
This.pNode = pContext.pNode : This.pFirstNode = pContext.pFirstNode : This.pLastNode = pContext.pLastNode
This.uCount = this.pFirstNode->BranchCount :
This.bSearchRes = pContext.bSearchRes
If pTmp2 <> 0 Then : pTmp2->pBranchLastNode = pContext.pBranchLastNode : pTmp2->BranchCount = pContext.BranchCount : End If
Return pTmp2
Else
zLong+=1
End If
If pTmp2->pNext <>0 Then : pTmp2= pTmp2->pNext : Else : this.pFirstNode->BranchCount=iLong-1 : End If
Next iLong
End If
This.pNode = pContext.pNode : This.pFirstNode = pContext.pFirstNode : This.pLastNode = pContext.pLastNode
This.uCount = pContext.uCount : This.bSearchRes = pContext.bSearchRes
If pTmp1 <> 0 Then : pTmp1->pBranchLastNode = pContext.pBranchLastNode : pTmp1->BranchCount = pContext.BranchCount : End If
this.VrallocSuccess=0
Return 0
End Property
Property List.HashDestroy() As Byte 'ne detruit pas les sous-arborescences interne à une branche
Dim pTmp1 as listnode Ptr : Dim pTmp2 As listnode Ptr
If this.pNode->pBranch <> 0 Then
pTmp2=this.pNode->pNext
this.uCount+= this.pNode->BranchCount+1 : this.pNode->BranchCount=0
this.pNode->pBranch->pBranch=0 : this.pNode->pBranch->pPrev=this.pNode
this.pNode->pNext=this.pNode->pBranch : this.pNode->pBranch=0
pTmp1=this.pNode->pBranchLastNode : pTmp2->pPrev=pTmp1 : pTmp1->pNext=pTmp2
Return 1
End If
Return 0
End Property
Property List.NewHash(pSourceNode As ListNode Ptr) As Byte
Dim iB As Byte
If pSourceNode->pBranch <> 0 Then : Return 0 : End If
this.pFirstNode->BranchCount = this.uCount
this.pFirstNode->pBranchLastNode = this.pLastNode
this.BlindTag(LIST_RES)
this.pNode->pPrev = this.pFirstNode
this.pNode->pBranch = pSourceNode
pSourceNode->pBranch = this.pNode
pSourceNode->BranchCount = 0
this.uCount = 0 : this.uHashCOUNT +=1
pSourceNode->pBranchLastNode = this.pNode
this.pFirstNode = pSourceNode->pBranch
this.pNode = this.pFirstNode
this.bSearchRes = 0 : this.sSearchTag = ""
End Property
Property List.Branch() As Listnode Ptr
Dim pTemp As listnode Ptr
this.pFirstNode->BranchCount = this.uCount
this.pFirstNode->pBranchLastNode = this.pLastNode
If this.pFirstNode->pBranch <> 0 Then
this.pFirstNode->pBranch->BranchCount = this.uCount
this.pFirstNode->pBranch->pBranchLastNode = this.pLastNode
End If
pTemp = this.pNode
If this.pNode->pBranch = 0 Then
this.NewHash(this.pNode)
Else 'Branche déjà créée
this.uCount = this.pNode->BranchCount
this.pFirstNode = this.pNode->pBranch
this.pLastNode = this.pNode->pBranchLastNode
this.pNode = this.pNode->pBranch
End If
this.bSearchRes = 0 : this.sSearchTag = ""
Return this.pFirstNode
End Property
Property List.UpLevel() As Byte
Dim pTemp As listnode Ptr : Dim iLong As uLongInt=0
If this.pFirstNode->pPrev = 0 Then : Return 0 : End If
If this.pFirstNode->pBranch <> 0 Then
this.pNode = this.pFirstNode->pBranch ' Retour node de départ pour faciliter un parcours éventuel
this.pFirstNode->pBranch->BranchCount = this.uCount
this.pFirstNode->pBranch->pBranchLastNode = this.pLastNode
If this.pFirstNode->pPrev <> 0 Then : this.pFirstNode = this.pFirstNode->pPrev : End If
this.uCount = this.pFirstNode->BranchCount
this.pLastNode = this.pFirstNode->pBranchLastNode
this.bSearchRes = 0 : this.sSearchTag = ""
Return 1
Else : Return 0
End If
End Property
'TYPE LIST PUBLIC PROPERTIES - FLAT CONTROL
Property List.Tag(str_Tag As String) As listnode Ptr
Dim pTemp As listnode Ptr : Dim item As ListContainer
If this.sSearchTag = str_Tag then
If this.bSearchRes=1 Then
pTemp = this.pSearchNode
Else
pTemp = this.pLastNode
this.uCount += 1
pTemp->pNext = this.AllowCake() 'And eat it
pTemp->pNext->pPrev = pTemp
pTemp->pNext->ListData = item
pTemp->pNext->Tag(uTag) = str_Tag
pTemp = pTemp->pNext
this.pLastNode = pTemp
End if
Elseif this.sWrkngTag(0) = str_Tag then
pTemp = this.pWrkngNode(0)
Else
If this.bSeekMethod=1 Then : pTemp = this.pFirstNode
Else : pTemp = this.pNode : If pTemp->pNext <> 0 Then : pTemp = pTemp->pNext : End If
End If
While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag)
pTemp = pTemp->pNext
Wend
if pTemp->Tag(uTag) = str_Tag then
Else 'New
this.uCount += 1
pTemp->pNext = this.AllowCake() 'And eat it
pTemp->pNext->pPrev = pTemp
pTemp->pNext->ListData = item
pTemp->pNext->Tag(uTag) = str_Tag
pTemp = pTemp->pNext
this.pLastNode = pTemp
End If
End If
this.pNode = pTemp
Return pTemp
End Property
Property List.Tag() As String : Return this.pNode ->tag(uTag) : End Property
Property List.Tag(i As Integer) As String : Return this.pNode ->tag(i) : End Property
Property List.HasTag(str_Tag As String) As Byte
Dim pTemp As listnode Ptr
Dim item As ListContainer
this.sSearchTag = str_Tag
If this.bSeekMethod=1 Then :pTemp = this.pFirstNode
Else
pTemp = this.pNode
If pTemp->pNext <> 0 Then : pTemp = pTemp->pNext '
Else : this.bSearchRes = 0 : Return 0
End If
End If
While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag AND pTemp <> this.pLastNode ) : pTemp = pTemp->pNext : Wend
If pTemp->Tag(uTag) = str_Tag then
this.pSearchNode = pTemp : this.bSearchRes = 1 : Return 1
Else : this.bSearchRes = 0 : Return 0 : End If
End Property
Property List.BlindTag(str_Tag As String) As listnode Ptr
Dim pTemp As listnode Ptr
Dim item As ListContainer
pTemp = this.pLastNode
' If pTemp=0 Then : Print "Pointer error" : End If
this.uCount += 1
pTemp->pNext = this.AllowCake() 'And eat it
pTemp->pNext->pPrev = this.pLastNode
pTemp->pNext->ListData = item
pTemp->pNext->Tag(uTag) = str_Tag
pTemp = pTemp->pNext
this.pLastNode = pTemp
this.pNode = pTemp
Return pTemp
End Property
Property List.RwTag(s_Tag As String) As listnode Ptr : this.pNode ->tag(this.uTag) = s_Tag : Return this.pNode : End Property
Property List.ColTags() As Byte : Return(this.uTag) : End Property
Property List.ColTags(i as Byte) As Byte : this.sSearchTag = "" : this.bSearchRes=0 : If i > ubound(this.pNode->Tag) then : this.uTag=Ubound(this.pNode->Tag) : Return 0 : Else : this.uTag=i : Return 1 : End If : End Property
Property List.UniqueTags(i as Byte) As Byte : If i=1 Then : this.bSeekMethod = 1 : Else : this.bSeekMethod = 0 : End If : Return this.bSeekMethod : End Property
Property List.AllOf() As UlongInt : this.pNode = this.pFirstNode : Return this.Count : End Property
Property List.Count() As UlongInt : Return this.uCount : End Property
Property List.First() As ListNode Ptr : this.pNode=This.pFirstNode->pNext : Return This.pFirstNode->pNext : End Property
Property List.Last() As ListNode Ptr : this.pNode=This.pLastNode : Return This.pLastNode : End Property
Property List.LastLast() As ListNode Ptr : this.pNode=This.pLastLASTNode : Return This.pLastLASTNode : End Property
Property List.Val(str_value As String) As listnode Ptr : this.pNode->ListData.sData = str_value : Return this.pNode : End Property
Property List.Val() As String : Return this.pNode->ListData.sData : End Property
Property List.ValTag(str_value As String) As String
Dim pTemp As listnode Ptr
If this.sSearchTag = str_value Then : pTemp = this.pSearchNode : Return pTemp->ListData.sData
Elseif this.sWrkngTag(0) = str_value Then : pTemp = this.pWrkngNode(0) : Return pTemp->ListData.sData
Elseif this.HasTag(str_value) Then : pTemp = this.pSearchNode : Return pTemp->ListData.sData
End If
Return("")
End Property
'Jumps
Property List.BlindStep() As listnode Ptr : If this.uCount>1 Then : this.pNode = this.pNode->pNext : End If : Return this.pNode : End Property
Property List.BlindStep(top As LongInt) As listnode Ptr
Dim As Long i, istep
If top>0 Then : istep = 1 :
If this.bStepCheck=1 Then : For i=1 To top step istep : If this.pNode->pNext <> 0 Then : this.pNode = this.pNode->pNext : End If : Next i
Else : For i=1 To top step istep : this.pNode = this.pNode->pNext : Next i
End If
ElseIf top = 0 Then : this.pNode = this.pLastNode
Else : istep = -1
If this.bStepCheck=1 Then : For i=-1 To top step istep : If this.pNode->pPrev <> 0 Then : this.pNode = this.pNode->pPrev : End If : Next i
Else : For i=-1 To top step istep :this.pNode = this.pNode->pPrev : Next i
End If
End If
Return this.pNode
End Property
Property List.Bsm(i As Byte) As Byte : this.bStepCheck=i : Return this.bStepCheck : End Property
'Put aside
Property List.Aside() As listnode Ptr : Return this.Aside(0) : End Property
Property List.Aside(i as ulong) As listnode Ptr
If ubound(this.pWrkngNode) < i then : i = ubound(this.pWrkngNode) : End If
this.pWrkngNode(i) = this.pNode
this.sWrkngTag(i) = this.pNode->Tag(uTag)
Return this.pNode
End Property
Property List.Recover() As listnode Ptr : Return this.Recover(0) : End Property
Property List.Recover(i as ulong) As listnode Ptr
this.pNode = this.pWrkngNode(i)
Return this.pNode
End Property
Property List.Drop() As listnode Ptr : this.Flat : this.GarbageCollector : Return this.pNode : End Property
Property List.HashDropAll() As List : this.DropAll : Dim tList As List : Return tList : End Property
Property List.DropAll() As uLongInt
this.AllFlat
Dim pTemp As listnode Ptr : Dim iLong As uLongInt=0 : Dim i As uByte=0
If this.count=0 Then : Return 1 : End If
pTemp = this.pFirstNode
While pTemp<>0 And pTemp<>pTemp->pNext And pTemp <> this.pLastLASTNode 'And this.pnode <> this.pLastLASTNode
this.pnode = pTemp : pTemp = pTemp->pNext
Deallocate this.pnode : this.uNodeCOUNT-=1
iLong+=1
Wend
If this.uNodeCOUNT>0 Then : If pTemp<>0 Then : Deallocate pTemp : iLong+=1 : End If : End If
this.bSeekMethod = 1 : This.uCount = 0 : This.uTag = 0 : This.sSearchTag = "" : For i=0 to Ubound(sWrkngTag) : sWrkngTag(i)="" : Next i
this.uNodeCOUNT= 0 : this.GarbageCOUNT = 0 : this.FlatCOUNT = 0
this.NewRoot
Return iLong
End Property
Property List.Exdim() As List : Dim tList As List : tList.ColTags(this.ColTags) : tList.UniqueTags(this.bSeekMethod) : Return tList : End Property
Property List.NewRoot() As uByte
pNode = AllowCake() : pFirstNode = pNode : pLastNode = pNode : bSeekMethod = 1 : uCount = 0 : uTag = 0
pFirstFIRSTNode = pNode : pLastLASTNode = pNode : pNode->Tag(uTag) = LIST_RES : pNode->ListData.sData = "": Return 1
End Property
'TYPE LIST PUBLIC PROPERTIES - HASH CONTROL
Property List.Root() As Byte
Dim pTemp As listnode Ptr
This.AllOf
If this.pFirstNode->pBranch <> 0 Then
pTemp = this.pFirstNode->pBranch : pTemp->BranchCount = this.uCount : pTemp->pBranchLastNode = this.pLastNode
this.UpLevel
this.pFirstNode = this.pFirstFIRSTNode : this.uCount = this.pFirstNode->BranchCount : this.pLastNode = this.pFirstNode->pBranchLastNode
this.bSearchRes = 0 : this.sSearchTag = "" : this.pNode = this.pFirstNode : Return 1
Else : Return 0
End If
End Property
Property List.HashStep() As Byte
If this.pnode->pNext = 0 And this.pFirstNode->pPrev = 0 Then : Return 0 : End If
While this.pnode->pBranch <> 0 : this.Branch : If this.pnode->pNext <> 0 And this.pnode <> this.pLastNode Then : this.pnode = this.pnode->pNext : Return 1 : End If : Wend
If this.pnode->pNext <> 0 And this.pnode <> this.pLastNode Then : this.pnode = this.pnode->pNext : Return 1 : End If ':Print "**" & this.pnode->Tag(0) : If this.pnode=this.pLastLASTNode Then : this.pnode->pNext=0 : End If
While this.UpLevel <> 0 : If this.pnode->pNext <> 0 And this.pnode <> this.pLastNode Then : this.pnode = this.pnode->pNext : Return 1 : End If : Wend
If this.pnode->pNext = 0 And this.pFirstNode->pBranch = 0 Then : this.pNode=This.pFirstFIRSTNode : Return 0 : End If : Return -1
End Property
Property List.HashTag(str_Tag As String) As Byte
Dim pTemp01 As ListNode Ptr : Dim Str_tmp As String : Dim Str_tmp2 As String : Dim hasBranched as ubyte=0
Dim HadHashTag As Byte=1 : Dim istep As Byte : Dim i as uByte : Dim u As byte=0 : Dim iLen As Byte=Len(str_tag) : Dim bFirstHash as byte=0
this.bSearchRes = 0 : this.sSearchTag = "" : istep = this.bHashLen
this.Root
For i=1 to Len(str_Tag) step istep
Str_tmp=Mid(str_Tag,i, istep) : u+=1
' FastMid(Str_tmp, str_Tag, i-1, istep) : u+=1 ' Fast Mid tested, works fine but slower on "small" strings
If this.HasTag(Str_tmp)=1 Then
this.Tag(Str_tmp)
ElseIf this.pLastNode<>0 Then
pTemp01 = this.pLastNode
this.BlindTag(Str_tmp)
this.pNode->pPrev = pTemp01
pTemp01->pNext = this.pNode
HadHashTag = 0
this.uHashCOUNT +=1
Else : Print "Pointer error - please report this message" : sleep : system
End If
If u*istep<iLen Then : hasBranched = 1 : this.Branch : End If
'clear cast(byte ptr, @Str_tmp)[0], 0, sizeof(Str_tmp) '' clear descriptor
Next i
Return HadHashTag
End Property
Property List.HashTag() As String
Dim pTemp01 As ListNode Ptr : Dim pTemp02 As ListNode Ptr : Dim Str_tmp As String
Dim str_arbo As String = "" : Dim iB As Byte : Dim str_res01 As String = "" : Dim istep as Byte = this.bHashLen : Dim u as byte=0
pTemp01 = this.pFirstNode
pTemp02 = this.pNode
str_arbo = this.pnode->Tag(uTag)
While pTemp01->pPrev <>0
If pTemp01->pBranch <> 0 Then
pTemp02 = pTemp01->pBranch
str_arbo = str_arbo + pTemp02->Tag(uTag)
End If
pTemp01 = pTemp01->pPrev
Wend
For iB=Len(str_arbo)-istep To 0 Step -istep :
str_res01 += Mid(str_arbo, iB+1, istep)
u+=1 :
Next iB : str_res01 += Left(str_arbo, Len(str_arbo)-u*istep)
Return str_res01
End Property
Property List.HasHashTag(str_Tag As String) As Byte
Dim Str_tmp As String
Dim HadHashTag As Byte=1 :Dim IsEtoile As Byte=0 : Dim i as uByte=1 : Dim t as uByte=Len(str_Tag) : Dim istep As Byte = this.bHashLen
this.bSearchRes = 0 : this.sSearchTag = ""
this.Root
Do
Str_tmp=Mid(str_Tag,i, istep)
If this.HasTag(Str_tmp)=1 Then
this.Tag(Str_tmp)
If this.pNode->Tag(1)="*" Then : HadHashTag = 1 : IsEtoile=1
ElseIf this.pNode->Tag(1)="!*" Then : HadHashTag = 0 : i=t
ElseIf this.pNode->Tag(1)="!" And i=t Then : HadHashTag = 0
ElseIf this.pNode->Tag(1)<>"" And i=t Then : HadHashTag = 1
Else : HadHashTag = 0 : End If
ElseIf IsEtoile=0 Then : HadHashTag = 0 : i=t
End If
If i<t Then : this.Branch : End If
i+=istep
Loop Until i>t
Return HadHashTag
End Property
Property List.HashLen(bHashLen As Byte) As Byte : this.bHashLen = bHashLen : Return 1 : End Property
Property List.HashCount As uLongInt : Return this.uHashCOUNT : End Property
Property List.AllFlat() As Byte : this.Root : this.AllOf : this.BlindStep : this.Flat : Return 1 : End Property
Property List.BranchFlat() As Byte : this.AllOf : this.Flat : Return 1 : End Property
Property List.GarbageCollector() As UlongInt 'permet de différencier les nodes issus du AllFlat d'éventuels nodes "classiques"
Dim iLong As UlongInt : Dim pTmp1 as listnode Ptr : Dim NbCollected As uLongInt=0 : Dim pTmp0 as listnode Ptr
This.Root : This.AllOf
If this.pFirstNode->pNext <>0 Then
pTmp1 = this.pFirstNode
If pTmp1<>0 Then
While pTmp1<>this.pLastLastNode
If pTmp1->Tag(MAX_COLS-1)= LIST_DEL Then : pTmp1->Tag(uTag) = LIST_DEL : pTmp1->Tag(MAX_COLS-1)="" : NbCollected +=1 : End If
pTmp1=pTmp1->pNext
Wend
For iLong=0 To this.FlatCOUNT
If pTmp1<>0 Then
pTmp1->Tag(uTag) = LIST_DEL
If pTmp1->Tag(MAX_COLS-1)= LIST_DEL Then : pTmp1->Tag(uTag) = LIST_DEL : pTmp1->Tag(MAX_COLS-1)="" : NbCollected +=1 : End If
pTmp1=pTmp1->pNext
End If
Next iLong
this.FlatCOUNT=0
End If
End If
This.AllOf : This.GarbageCOUNT = NbCollected
Return NbCollected '
End Property
Property List.GarbageCt() As UlongInt : Return this.GarbageCOUNT : End Property
Property List.NodeCount() As UlongInt : Return this.uNodeCOUNT : End Property
CONST PRODUCT_LIC = "- LZListsEngine Library by E. Carfagnini - (Note : License term's are copy-pasted from TinyDialog's one ;-)" & Chr(10) &_
"All the products under this license are free software: they can be used for both academic and commercial purposes at absolutely no cost. " & Chr(10) &_
"There are no paperwork, no royalties, no GNU-like 'copyleft' restrictions, either. Just download and use it. " & Chr(10) &_
"They are licensed under the terms of the MIT license reproduced below, and so are compatible with GPL and also qualifies as Open Source software. " & Chr(10) &_
"They are not in the public domain, autors keeps their copyright. The legal details are below." &Chr(10) &_
"The spirit of this license is that you are free to use the libraries for any purpose at no cost without having to ask us. " & Chr(10) &_
"The only requirement is that if you do use them, then you should give us credit by including the copyright notice below somewhere in your product or its documentation. " & Chr(10) &_
"A nice, but optional, way to give us further credit is to include the following mention ''LoveZerglingsWare : I love Zerglings'' or autor's name in your licence's or contribution's list." & Chr(10) &_
"Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ''Software''), to deal in the Software without restriction, including without limitation" & Chr(10) &_
"the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions :" & Chr(10) &_
"The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software." & Chr(10) &_
"THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, " & Chr(10) &_
"FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, " & Chr(10) &_
"WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. "
'-------------------Constructor & Destructor-------------------
Constructor List()
'Print PRODUCT_LIC
pNode = AllowCake() ' Moment angulaire(petite masse)
pFirstNode = pNode : pLastNode = pNode : bSeekMethod = 1 : uCount = 0 : uTag = 0
pFirstFIRSTNode = pNode : pLastLASTNode = pNode
pNode->Tag(uTag) = LIST_RES : pNode->ListData.sData = ""
End Constructor
Destructor List()
this.DropAll : Deallocate this.pNode
End Destructor