Alpha 1 is now outdated. This post is an archive of previous code. 1/2.
Alpha 1 Bugged on an optimization algo : keys not properly set in some cases.
Replace "If pFirstNode<>pFirstFIRSTNode Then" by "If pFirstNode<>pFirstFIRSTNode And 1=0 Then" to desactivate optimization algo
Code: Select all
' NOTICE : Thank you to remove first single quote on the line below once you accepted the licence.
' /' In case redistribution of SOURCES you may ensure to reactivate the acceptance of the license. This notice may be anywhere in source code till licensed user is aware it exists.
CONST PRODUCT_LIC =_
"_______________________________________________________________________________" & chr(10) &_
" LZListsEngine/ListsVM by Etienne Carfagnini - contact:etienne.carfa@gmail.com" & chr(10) &_
" Bd Henri Barbusse 92700 Colombes France 01 46 49 99 02" & chr(10) &_
"-------------------------------------------------------------------------------" & chr(10) &_
" This Freeware/Openware licence specify the rights to use the software" & chr(10) &_
"* Distribution of derivating software : " & chr(10) & " The information access to the original software must be guaranteed to" & chr(10) & " developers and users (https://freebasic.net/forum/ or alternative mentionned)" & chr(10) &_
"* Right to use the software and its derivating : 2 options : " & chr(10) & " >OPTION 1 (Openware) :" & chr(10) & " The software is free for any use." & chr(10) &_
" 'LZLE Openware licence' is mentionned in licence contributors." & chr(10) &_
" The software must be compiled using any official GPL FreeBasic Compiler." & chr(10) & " (https://freebasic.net/forum/viewforum.php?f=1)" & chr(10) &_
" Plattform (or virtual) using the software is open & compliant with FreeBasic." & chr(10) &_
" >OPTION 2 (Freeware):" & chr(10) & " The software is free for any use except the following limitation as to its" & chr(10) & " fields of application : not for use on virtual machine or on virtual server." & chr(10) &_
" 'LZLE Freeware licence' is mentionned in licence contributors." & chr(10) &_
"* Apart from the restrictions of use (options 1 and 2) which are not compatible" & chr(10) & " with the rights of uses specified in clause 5.1, the legal clauses whenever" & chr(10) &_
" compatible will be those specified by the CeCILL-C license" & chr(10) & " ( http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.txt )" & chr(10) &_
" Disclaimer :" & chr(10) & " This licence refers to CeCILL-C but is NOT a CeCILL-C because the right to" & chr(10) & " use the software with no restriction is limited to the FreeBasic ecosystem." & chr(10) &_
" This because it aims to be an extension of the language instructions set." & chr(10) &_
" LZLE (instruction set architecture,coding style) is dedicated to FreeBasic." & chr(10) &_
" This notice constitutes a whole that must be present in the source code." & chr(10) &_
"-------------------------------------------------------------------------------" & chr(10) &_
" Cette licence Freeware/Openware precise les droits a utiliser le logiciel" & chr(10) &_
"* Distribution de logiciels derives :" & chr(10) & " L'acces informatif au logiciel original doit etre garanti aux" & chr(10) & " developpeurs et aux utilisateurs (https://freebasic.net/forum/ ou autre)." & chr(10) &_
"* Droit d'utiliser le logiciel et ses derives : 2 options : " & chr(10) & " >OPTION 1 (Libre) :" & chr(10) & " Le logiciel est gratuit pour toute utilisation." & chr(10) &_
" 'LZLE licence Openware' est mentionne dans les contributions." & chr(10) &_
" Le logiciel doit etre compile en utilisant n'importe quel compilateur GPL" & chr(10) & " FreeBasic 'officiel' (https://freebasic.net/forum/viewforum.php?f=1)" & chr(10) &_
" La plate-forme d'execution du logiciel est ouverte et compatible FreeBasic." & chr(10) &_
" >OPTION 2 (Gratuiciel) :" & chr(10) & " Le logiciel est gratuit pour tout usage sauf la limitation suivante quant a" & chr(10) & " son champs d'application : pas d'utilisation sur machine ou serveur virtuel." & chr(10) &_
" 'LZLE licence Freeware' est mentionne dans les contributions." & chr(10) &_
"* En dehors des restrictions d'utilisation (options 1 et 2) lesquelles ne sont " & chr(10) & " pas compatibles avec les droits d'utilisation prevus a la clause 5.1, les" & chr(10) &_
" clauses applicables seront celles compatibles specifiees par la licence" & chr(10) & " CeCILL-C ( http://www.cecill.info/licences/Licence_CeCILL-C_V1-fr.txt )" & chr(10) &_
" Avertissement :" & chr(10) & " Cette licence fait reference a la licence CeCILL-C mais n'en est PAS une car" & chr(10) & " le droit a utiliser librement le logiciel est limite a l'ecosysteme FreeBasic" & chr(10) &_
" Ce moteur de liste a jeu d'instructions est dedie au langage FreeBasic" & chr(10) &_
" Cette notice constitue un tout lequel doit etre present dans le code source." & chr(10) &_
"_______________________________________________________________________________"
Dim k As String
Print PRODUCT_LIC : Print
Print "Please press 'Y' (Yes) to accept the licence or Esc to abort"
Print "Merci d'appuyer sur 'O' (Oui) pour accepter la licence ou echap pour annuler"
Do : k = Inkey : Select Case k : Case "Y" : Exit Do : Case "y" : Exit Do : Case "O" : Exit Do : Case "o" : Exit Do : Case Chr(27) : System : End Select : Loop
Print "Removing first single quote on line 2 in source code will activate the licence" : Print "Retirer la premiere simple quote en ligne 2 du code source activera la licence" : Print "Thank you for chosing this software - Merci d'avoir choisi ce logiciel" : Print
'/ ' END NOTICE
CONST RUP_COLS=1 : CONST MAX_COLS=5 ' Le nombre maximal de clefs pouvant être utilisées sur la MEME liste start=0
CONST LIST_RES=Chr(18) : CONST LIST_DEL=Chr(3) : CONST LIST_ROOT=Chr(4)
Type ListContainer 'Data Segment Level
Dim str_tag_C(RUP_COLS+1 to MAX_COLS-1) As String
Dim str_item as String : Dim pNextContainer as ListContainer Ptr
End Type
Type ListNode 'ListNode Level
Dim Tag(0 to RUP_COLS) As String : Dim As ListContainer Ptr ListData : Dim As ListNode Ptr pNext, pPrev, pBranch, pBranchLastNode : Dim BranchCount As uInteger=0
End Type
Type ListContext ' Branch context Level
Dim As ListNode Ptr pNode, pFirstNode, pLastNode : Dim As String LcHashTag : Dim As uInteger uCount : Dim As uByte bLcHashLen
End Type
Type List
Declare Constructor() : Declare Destructor()
Private:
Dim As ListContext Lcontext(0 to MAX_COLS-1), Tracks(0 to MAX_COLS-1)
Dim As ListNode Ptr pNode, pFirstNode, pLastNode, pFirstFIRSTNode, pLastLASTNode, pGarbage, pEndFlat, pLocalRoot, pLocalMove, pWhyteMove, pFlatRoot, pSearchNode, pValTmp, TrackTrace(0 to MAX_COLS-1), pLatestHTag
Dim As ListContainer Ptr pPanCakeGarbage, pLastPanCake
Dim As String sSearchTag, sLatestHTag
Dim As uLONG uNodeCOUNT, uGarbCt, uCount, uContainerGarbCt, uContainerGivenCt : Dim zStringLen as uByte=80
Dim uTag As Byte=0 : Dim bSearchRes As Byte=0 : Dim bRHByPass As Byte=0 : Dim bHashStepRev As Byte=0 : Dim bfStepZero As Byte=0 : Dim bTrackingMethod As Byte=0 : Dim bTracking As Byte=0 : Dim bHTMethod As Byte=0
Dim bNFmethod As Byte=1 : Dim bRHmethod As Byte=-1 : Dim bHashLen As uByte=1 : Dim bAutoCursor As Byte=1 : Dim bSeekMethod As Byte=2 : Dim bBranchCountDown As Byte=0 : Dim bPickReduce As Byte=0
Declare Property AllowCake() As ListNode Ptr ' Cooking here
Declare Property AllowPanCake() As ListContainer Ptr ' No comment
Declare Property Flat() As uByte ' Détruit une arborescence à partir du pointeur courant (pNode)
Declare Property AllFlat() As uByte ' Destroy a hierarhical list to a flat list
Declare Property GarbageCollector() As uInteger ' All elements in root list (except garbaged & Flat List entry are send to GarbageCollector
Declare Property Branch() As Byte ' Descend dans la liste enfants, creation de nouvelles entrées
Declare Property UpLevel() As Byte ' Revient à la liste parente
Declare Property NodeRecycle() as Byte ' Supression en décalé (NodeFlat)
Declare Property NodeRecycle2() as Byte ' Supression en décalé (RestoreHash)
Declare Property RootPrivate As Byte ' Accès direct rapide à la racine
Declare Property AllOfPrivate As uInteger
Declare Property FlatStack(uB as uByte) As Byte ' Construction de la Flat List avec retour à la racine(0) ou accès à la flat liste (1)
Declare Property BCountDown(i As Byte) As Byte ' CountDown calculation
Declare Property TrackCompute As Byte
Declare Property ValPrivate(str_Value As String) As Byte
Declare Property ValPrivate As String
Public:
'Special features - Private declared Public
Declare Property GiveBranch As ListNode Ptr
Declare Property GiveFlat As ListNode Ptr
Declare Property GiveGarbage As ListNode Ptr
Declare Property GivePanCake As ListContainer Ptr
Declare Property GiveLastPanCake As ListContainer Ptr
Declare Property GivePanCakeCount As uInteger
'Flat control
Declare Property Tag(str_Tag As String) As Byte ' 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 ' Return 1 if Tag exists
Declare Property BlindTag(str_Tag As String) As Byte ' Create a new ListNode with Key=str_Tag at end of the list
Declare Property RwTag(s_Tag As String) As Byte ' Rewrite Tag Value of current Node : if current node is Hashed, just rewrite HashTag Value not effective Key value
Declare Property RwTag1(s_Tag As String) As Byte ' Rewrite Tag Value(1)
Declare Property RwTag2(s_Tag As String) As Byte ' Rewrite Tag Value(2)
Declare Property RwTag3(s_Tag As String) As Byte ' Rewrite Tag Value(3)
Declare Property RwTag4(s_Tag As String) As Byte ' Rewrite Tag Value(4)
Declare Property ColTags As Byte ' Renvoie le numéro de la colonne de tag active
Declare Property SeekMethod(i as Byte) As Byte ' Method for Tag(string), HasTag(string), HashTag(string), HasHashTag and HasKey: 1(default)=seek from First to Last | 2: seek from Lastnode to firstNode | 0 :seek from currentnode to last node (Flat multikeys)
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 AllOf As uInteger ' Return number of node in considered Flat List (root or branch), set position to the first node of current branch
Declare Property Count As uInteger ' Return current node Count of considered Flat List
Declare Property First As Byte 'Set current node to first node considering flat list (root or branch)
Declare Property Last As Byte 'Set current node to Last node considering flat list (root or branch)
Declare Property Val(str_value As String) As Byte ' 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
Declare Property fStep As Byte ' FOR EACH - While MyList.fStep : .. : Wend Jump to next node till current flat list end
Declare Property fStepRev As Byte ' FOR EACH - Idem fStep Jump to previous node till current flat list reach firstnode
Declare Property bStep As Byte ' FOR NEXT - For i=1 to MyList.AllOf : MyList.bStep : ..... : Next i -> Jump to next node (NO CHECK)
Declare Property BlindStep As Byte ' FOR EACH - While MyList.BlindStep : .. : Wend -And- FOR NEXT - For i=1 to MyList.AllOf : MyList.BlindStep : ..... : Next i Jump to next node (check)
Declare Property BlindStep(i As Integer) As Byte ' Jump to +/-n nodes BlindStep(0) equiv Last : goto LastNode (NO CHECK)
Declare Property fMove(i As Integer) As Byte ' Move a node +/- n positions
'Hash control handling
Declare Property Root As Byte ' Check/Restore List integrity & set cursor to First node of root flat list - Shall be called before HashStep or After NodeFlat or RestoreHash
Declare Property FlatStack As Byte ' Flat List Access : use it before RestoreHash
Declare Property RootNode As Byte ' Set cursor to Root node of root flat list
Declare Property EndNode As Byte ' Set cursor to the last logical node ( = While MyList.HashStep : Wend ) which is the last node of the last branch of last root flat node
Declare Property HashStep As Byte ' FOR EACH - recursive parse property : syntax : While MyList.HashStep=1 : ... : Wend
Declare Property HashStepRev As Byte ' FOR EACH - idem HashStep
Declare Property KeyStep As Byte ' FOR EACH - While MyList.KeyStep=1 : ... : Wend idem HashStep but show only Keys tagged by user, not the tree structure
Declare Property KeyStepRev As Byte ' FOR EACH - idem KeyStep
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 HashSort(ub as Byte) as Byte
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 HasKey(str_Tag As String) As Byte ' Idem HasHashTag Return 1 only for values specified with HashTag (not all cascaded index values)
Declare Property HashLen(bHashLen As uByte) As Byte ' Longueur des clefs en cascade
Declare Property NFmethod(i As Byte) As Byte ' Determine le fonctionnement de NodeFlat : NFmethod=-1 node=>GarbageCollector NFmethod=0 node=>FlatList sauf parents reliquataires NFmethod=1 node=>FlatList même les nodes parents contenant toujours des dépendances
Declare Property NFrecursive(i As Byte) As Byte
Declare Property NodeFlat As Byte ' Déréférence une arborescence de clefs (un HashTag), et traite les données en conséquence
Declare Property RHmethod(i As Byte) As Byte ' Determine le fonctionnement de RestoreHash par rapport aux doublons : RHmethod=-1 : Hashnode->GarbageCollector / RHmethod=0 : no swap / RHmethod=1 : Hashnode->FlatList
Declare Property RestoreHash As Byte ' Envoi un node de la Flat List en Hash List (réindexation)
'Hash Control - special
' Declare Property HashMap(str_Tag() As String Ptr) As Byte ' to do
' Declare Property HashMap As Byte ' to do
'Flow control
Declare Property BranchCountDown(i As Byte) As Byte ' 1/0 Activate(1) or desactivate(0) BranchCountDown, default 0
Declare Property BranchCount As uInteger 'Return Branch Count
Declare Property Up As Byte 'idem UpLevel
Declare Property Down As Byte 'idem Branch but prevent from creating an orphan sublist entry
Declare Property AutoCursor(i As Byte) As Byte 'Method for HasTag(string), HasHashTag and HasKey: 1(default)=move current to found on success (HasHashTag), 0=do nothing current node is unchanged, 2=move current to found on success (HasKey), 3=move on partial success
Declare Property HoldBack As Byte
Declare Property HoldBack(i As Byte) As Byte
Declare Property TrackStep As Byte ' -SELECTIVE- FOR EACH - While MyList.TrackStep=1 : ... : Wend : selective PARSE only Keys marked for tracking by HoldBack
Declare Property Track As Byte
Declare Property Track(i As Byte) As Byte
Declare Property TrackSet As Byte
Declare Property TrackSet(i As Byte) As Byte
Declare Property IsTracked As Byte
Declare Property TrackMethod(by As Byte) As Byte ' MyList.TrackMethod(0)=might be faster / MyList.TrackMethod(1)=more secure
Declare Property Aside As Byte ' Memorise ListNode ptr dans le pointeur n°0
Declare Property Aside(i As Byte) As Byte ' Memorise ListNode ptr dans le pointeur n°i
Declare Property Recover As Byte ' 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 Byte) As Byte ' Repositionne l'élément courant de la liste sur celui mémorisé par Take(i)
'Memory management
Declare Property FlatCount As uInteger ' Return number of values stored in Flat List
Declare Property GarbageCount As uInteger ' Return number of nodes available in garbage collector
Declare Property ContainerCount As uInteger ' Return number of nodes container available in hidden garbage collector
Declare Property NodeCount As uInteger ' Return number of nodes including not visible ones
Declare Property GarbageFlat As Byte 'Send all Flat List to GarbageCollector
Declare Property Recycle As uInteger 'AllFlat+GarbageCollector : détruit une arborescence et envoi tout en GarabgeCollector - do NOT garbage protected flat list
Declare Property DropAll As uInteger 'Remove all elements in list
Declare Property Destroy As Byte 'Manual destructor
'List Data Exchange
Declare Property SnatchBelow(pList As List) As Byte 'Snatch a whole branch from another List Below current node
Declare Property Snatch(pList As List) As Byte ' Snatch a whole branch from another List to next node
Declare Property FlatSnatch(pList As List) As Byte 'Target's Flat list is transfered to current list
Declare Property GarbageSnatch(pList As List) As Byte 'Target's Garbage Collector is transfered to current list
'Debug
Declare Property NextNode As String
' Declare Property PrevNode As String
End Type
' to do : HashMap / Tris / SmartPatterns (?) /
' to do : test++%TrackSet / BranchUp /
' BUGs :
Property List.NextNode As String : Dim str_tmp as string="-" : If pNode->pNext<>0 Then : this.Aside : pNode=pNode->pNext : str_tmp= "next tag=" & pNode->Tag(0) & " & next hashtag=" & this.HashTag : this.Recover : Return str_tmp : End If : End Property
'Property List.PrevNode As String : Dim str_tmp as string="-" : If pNode->pPrev<>0 Then : this.Aside : pNode=pNode->pPrev : str_tmp= " prev tag=" & pNode->Tag(0) & " & prev hashtag=" & this.HashTag & " branch=" & Str(pNode->pBranch) : this.Recover : Return str_tmp : End If : End Property
'==========================================================================================CONSTRUCTOR & DESTRUCTOR : this.pFirstNode->pBranch->pBranchLastNode=0
Constructor List
pFlatRoot = CAllocate(Len(ListNode)) : pNode = CAllocate(Len(ListNode)) ' Moment angulaire(petite masse)
pFirstNode = pNode : pLastNode = pNode : bSeekMethod = 1 : uCount = 0 : uTag = 0 : this.pPanCakeGarbage=cAllocate(Len(ListContainer)) : pPanCakeGarbage->pNextContainer=pPanCakeGarbage ' Moment Angulaire(petite masse)
pFirstFIRSTNode = pNode : pLastLASTNode = pNode : this.pFirstNode->BranchCount=0 : pNode->Tag(0) = LIST_RES
pFirstFIRSTNode->pNext=pFlatRoot : pFlatRoot->pPrev=pFirstFIRSTNode : pFlatRoot->Tag(0)=LIST_ROOT
this.uNodeCOUNT+=2 : this.Root
End Constructor
Destructor List : this.Destroy : End Destructor
'==========================================================================================TYPE LIST PRIVATE PROPERTIES
Property List.AllowCake As ListNode Ptr ' This.Vralloc
Dim pTemp as ListNode Ptr=pFlatRoot->pNext ' uGarbCt>1 ' If pTemp<>0 Then : If pTemp->pNext=0 Then : pTemp=pGarbage : pTemp=CAllocate(Len(ListNode)) : this.uNodeCOUNT+=1 : Return pTemp : End If : End If
If pTemp<>pGarbage And pTemp<>0 Then : pFlatRoot->pNext=pTemp->pNext : pTemp->pNext->pPrev=pFlatRoot : pTemp->pBranch=0 : This.uGarbCt-=1 : 'pTemp->pNext=0 : pTemp->pPrev=0 :
Else : pTemp=CAllocate(Len(ListNode)) : this.uNodeCOUNT+=1 : this.pLastLASTNode=pTemp ' Moment Angulaire(petite masse)
End If : Return pTemp
End Property
Property List.AllowPanCake As ListContainer Ptr
Dim pPanTemp As ListContainer Ptr : dim uB As uByte
If pPanCakeGarbage->pNextContainer<>pPanCakeGarbage Then
pPanTemp=pPanCakeGarbage->pNextContainer : pPanTemp->str_item="" : For uB=RUP_COLS+1 To MAX_COLS-1 : pPanTemp->str_tag_C(uB)="" : Next uB
pPanCakeGarbage->pNextContainer=pPanCakeGarbage->pNextContainer->pNextContainer : uContainerGarbCt-=1 : pPanTemp->pNextContainer=0
Else : pPanTemp=cAllocate(Len(ListContainer)) ' : pPanTemp->str_item="" ' Moment Angulaire(petite masse)
End If : Return pPanTemp
End Property
Property List.Flat As uByte
Dim pTemp As ListNode Ptr : Dim pTemp2 As ListNode Ptr : Dim pContextRetour As ListContext
If pLocalMove=pLastLASTNode Then : pLastLASTNode=pLastLASTNode->pPrev : End If : this.NodeRecycle
If this.pFirstNode=this.pFirstFIRSTNode Then : pNode= this.pGarbage->pNext : Else : pNode= this.pFirstNode->pNext : End If
If pNode <>0 Then
Do
If pNode->Tag(0)<>LIST_RES And pNode->pBranch<>0 Then
pNode->pNext->pPrev=pNode->pBranch->pBranchLastNode : pNode->pBranch->pBranchLastNode->pNext=pNode->pNext
pNode->pNext=pNode->pBranch : pNode->pBranch->pBranch=0 : pNode->pBranch=0
pNode->pNext->pPrev=pNode : pNode->pNext->Tag(0)=LIST_DEL : pNode->pNext->pBranchLastNode=0
Else : If this.pNode->pNext<>0 Then : this.pNode=this.pNode->pNext : End If
End If
Loop Until pNode=this.pLastLASTNode Or pNode=pWhyteMove
End If : this.RootPrivate
Return 1
End Property
Property List.AllFlat As uByte : this.Root : Return this.Flat : End Property
Property List.GarbageCollector As uInteger
Dim pTemp1 as ListNode Ptr : Dim pTemp2 as ListNode Ptr : Dim NbCollected As uInteger=0 : Dim iLong As uInteger=0
If pGarbage->ListData<>0 Then : pGarbage->ListData->pNextContainer=pPanCakeGarbage->pNextContainer : pPanCakeGarbage->pNextContainer=pGarbage->ListData : pGarbage->ListData=0 : uContainerGarbCt+=1 : End If
This.RootPrivate : pTemp1=this.pGarbage->pNext : If pTemp1=0 Then : Return 0 : End If
While pTemp1->pNext<>0
pTemp1->Tag(0) = LIST_DEL : pTemp1->Tag(1)=""
If pTemp1->ListData<>0 Then : pTemp1->ListData->pNextContainer=pPanCakeGarbage->pNextContainer : pPanCakeGarbage->pNextContainer=pTemp1->ListData : pTemp1->ListData=0 : uContainerGarbCt+=1 : End If
NbCollected +=1 : pTemp1=pTemp1->pNext : iLong+=1
Wend
If NbCollected>0 Then : This.uGarbCt+=NbCollected : uCount=2 : this.pFirstNode->BranchCount=this.uCount : pLastNode=pTemp1 : If pFirstNode=pFirstFIRSTNode Then : pLastLASTNODE=pTemp1 : End If : End If
This.RootPrivate : pGarbage=pLastNode->pPrev : pTemp1=pNode : pNode=pGarbage : this.Val(LIST_DEL) : pNode=pTemp1 :
Return NbCollected
End Property
Property List.Branch As Byte
Dim pTemp As ListNode Ptr : Dim pTemp1 As ListNode Ptr
this.pFirstNode->BranchCount = this.uCount : this.pFirstNode->pBranchLastNode = this.pLastNode
pTemp = this.pNode
If this.pNode->pBranch=0 Then ' this.NewHash(this.pNode)
pTemp1 = this.pLastNode : this.uCount+=1 : pTemp1->pNext = this.AllowCake 'And eat it
pTemp1->pNext->pPrev = pTemp1 : pTemp1->pNext->Tag(uTag) = LIST_RES
pTemp1 = pTemp1->pNext : this.pLastNode = pTemp1 : pNode=pTemp1 ' this.BlindTag(LIST_RES) :
this.pNode->pPrev=this.pFirstNode : pNode->pBranch = pTemp
pTemp->pBranch=this.pNode : pTemp->BranchCount=0 : this.uCount=0 : pTemp->pBranchLastNode=this.pNode
this.pFirstNode=pTemp->pBranch : this.pNode = this.pFirstNode : this.bSearchRes = 0 : Return 0
Else 'Branche déjà créée
this.pFirstNode = this.pNode->pBranch : this.uCount = this.pFirstNode->BranchCount
this.pLastNode = this.pNode->pBranch->pBranchLastNode
this.pNode = this.pNode->pBranch : this.bSearchRes = 0 : Return 1
End If
End Property
Property List.UpLevel As Byte
If this.pFirstNode->pPrev = 0 Then : Return 0 : End If
If this.pFirstNode->pBranch <> 0 Then ' Retour node de départ pour faciliter un parcours éventuel
this.pNode = this.pFirstNode->pBranch : this.pFirstNode->BranchCount = this.uCount : this.pFirstNode->pBranchLastNode = this.pLastNode
this.pFirstNode = this.pFirstNode->pPrev : this.uCount = this.pFirstNode->BranchCount : this.pLastNode = this.pFirstNode->pBranchLastNode
this.bSearchRes = 0 ': this.sSearchTag = ""
Return 1
Else : Return 0
End If
End Property
Property List.NodeRecycle as Byte
If pLocalMove<>0 Then 'pLocalMove est un node à suppression décalée
pLocalMove->pPrev=this.pFlatRoot : pLocalMove->pNext=this.pFlatRoot->pNext : pLocalMove->Tag(0)=LIST_DEL : pLocalMove->pBranch=0 : pLocalMove->Tag(1)=""
If pLocalMove->ListData<>0 Then : pLocalMove->ListData->pNextContainer=pPanCakeGarbage->pNextContainer : pPanCakeGarbage->pNextContainer=pLocalMove->ListData : pLocalMove->ListData=0 : uContainerGarbCt+=1 : End If
this.pFlatRoot->pNext->pPrev=pLocalMove : this.pFlatRoot->pNext=pLocalMove : this.uGarbCt+=1
pLocalMove = 0
End If
Return 1
End Property
Property List.NodeRecycle2 as Byte
If pLocalRoot<>0 Then 'pLocalRoot est un node LIST_RES
pLocalRoot->pPrev=this.pFlatRoot : pLocalRoot->pNext=this.pFlatRoot->pNext : pLocalRoot->Tag(0)=LIST_DEL
this.pFlatRoot->pNext->pPrev=pLocalRoot : this.pFlatRoot->pNext=pLocalRoot : This.uGarbCt+=1
pLocalRoot->pBranch->pBranch=0 : pLocalRoot->pBranch->pBranchLastNode=0 : pLocalRoot->pBranch->BranchCount=0 :
pLocalRoot->BranchCount=0 : pLocalRoot->pBranch=0 : pLocalRoot = 0
End If
Return 1
End Property
Property List.RootPrivate As Byte
this.AllOfPrivate : While this.pFirstNode->pBranch <> 0 : this.UpLevel : Wend
this.pFirstNode = this.pFirstFIRSTNode : this.bSearchRes = 0 : this.sSearchTag = ""
this.pNode = this.pGarbage
Return 1
End Property
Property List.AllOfPrivate As uInteger
this.pNode = this.pFirstNode
If this.pFirstNode=this.pFirstFIRSTNode Then
this.pNode = this.pGarbage
If pWhyteMove<>0 And pWhyteMove<>pLastNode Then 'Changement de fonctionnement - Patch de compatibilité - : il faut un dernier node logique à blanc
If pWhyteMove->pNext<>0 Then : pWhyteMove->pPrev->pNext=pWhyteMove->pNext : pWhyteMove->pNext->pPrev=pWhyteMove->pPrev : pLastNode->pNext=pWhyteMove : pWhyteMove->pPrev=pLastNode : End If
pLastNode=pWhyteMove : pLastNode->pNext=pFirstFIRSTNode '0
End If
End If : Return this.Count
End Property
Property List.FlatStack(uB As Ubyte) As Byte
'Gestion du contexte de la Flat List qui doit contenir un dernier node à blanc
Dim pTemp1 As ListNode Ptr
This.RootPrivate : this.pNode=this.pFlatRoot : this.Branch
If this.pLastNode=this.pFlatRoot->pBranch Then
If this.pEndFlat<>0 Then : this.pFlatRoot->pBranch->pNext=pEndFlat : pEndFlat->pPrev=this.pFlatRoot->pBranch : this.pEndFlat->pNext=0 : this.pLastNode=this.pEndFlat
Else : this.BlindTag("") : this.pEndFlat=this.pNode : this.uCount -=1
End If
ElseIf this.pLastNode<>this.pEndFlat Then
If this.pEndFlat<>0 Then
this.pEndFlat->pPrev->pNext=this.pEndFlat->pNext : this.pEndFlat->pNext->pPrev=this.pEndFlat->pPrev
this.pEndFlat->pPrev=this.pLastNode : this.pLastNode->pNext=this.pEndFlat : this.pEndFlat->pNext=0 : this.pLastNode=this.pEndFlat
Else : this.BlindTag("") : this.pEndFlat=this.pNode : this.uCount -=1
End If
End If
this.pFirstNode->pBranchLastNode = this.pLastNode
If uB=0 Then : this.UpLevel : End If : this.AllOfPrivate
Return 1
End Property
Property List.BCountDown(i As Byte) As Byte : Dim pTemp As ListNode Ptr=pFirstNode : While pTemp->pPrev<>0 : If pTemp->pBranch<>0 Then : pTemp->pBranch->BranchCount+=i : End If : pTemp=pTemp->pPrev : Wend : Return 1 : End Property
Property List.TrackCompute As Byte
Dim As ListNode Ptr pTemp1=pNode : While pTemp1->Tag(0)<>LIST_RES And pTemp1<>pGarbage : pTemp1=pTemp1->pPrev : Wend : If pTemp1=pGarbage Then : pTemp1=pFirstFIRSTNode : End If
pFirstNode=pTemp1 : pLastNode=pTemp1->pBranchLastNode : uCount=pTemp1->BranchCount : Return 1
End Property
Property List.ValPrivate(str_value As String) As Byte : If this.pValTmp->ListData=0 Then : this.pValTmp->ListData=this.AllowPanCake : End If : this.pValTmp->ListData->str_item=str_value : Return 1 : End Property
Property List.ValPrivate As String : If this.pValTmp->ListData=0 Then : Return "" : End If : Return this.pValTmp->ListData->str_item : End Property
'==========================================================================================TYPE LIST PUBLIC PROPERTIES destination is PRIVATE USE
Property List.GiveBranch As ListNode Ptr
Dim As ListNode Ptr pTemp1, pTemp2, pTemp3
bfStepZero=0
If pNode=pLocalMove And pLocalMove->Tag(0)=LIST_RES Then : pNode=pNode->pNext
ElseIf pNode=pWhyteMove Then : If pNode=pLastNode Then : Return 0 : Else : pTemp1=pNode->pNext : This.Root : pNode=pTemp1 : End If
ElseIf pNode->Tag(0)=LIST_DEL Or pNode=pFlatRoot Then : Return 0 ' : End If
ElseIf pNode=pFirstNode And pNode->pBranch<>0 Then : this.BlindStep : this.UpLevel : bfStepZero=1 : End If
If bBranchCountDown=1 Then : this.BCountDown(-pNode->BranchCount) : End If : This.NodeRecycle
pTemp1=pNode : pTemp2=pNode->pPrev : pTemp3=pNode->pNext
If pLastNode=pFirstNode->pNext And pFirstNode<>pFirstFIRSTNode Then
this.NodeRecycle2 : pFirstNode->pBranch->pBranch=0 : pLocalRoot=pFirstNode : this.UpLevel : this.NodeRecycle2 : bfStepZero=1 : Return pTemp1
Else : pNode->pPrev->pNext=pNode->pNext : pNode->pNext->pPrev=pNode->pPrev : uCount-=1 : pFirstNode->BranchCount-=1
End If
If pTemp1=pLastNode Then : pLastNode=pTemp1->pPrev : pTemp1->pNext=0 : End If
pNode=AllowCake : pLocalMove=pNode : pLocalMove->pPrev=pTemp2 : pLocalMove->pNext=pTemp3 : pLocalMove->Tag(0)=LIST_RES
Return pTemp1
End Property
Property List.GiveFlat As ListNode Ptr
Dim As ListNode Ptr pTemp1, pTemp2
If pFlatRoot->pBranch=0 Then : Return 0 : End If
If pFlatRoot->pBranch->pNext=pFlatRoot->pBranch->pBranchLastNode Or pFlatRoot->pBranch->pNext=pFlatRoot->pBranch Then : Return 0 : End If
pTemp1=pFlatRoot->pBranch->pNext : pTemp2=pEndFlat->pPrev : If pTemp2=0 Or pTemp1=pTemp2 Then : Return 0 : End If
pTemp1->pBranch=pTemp2 : pFlatRoot->pBranch->pNext=pEndFlat : pEndFlat->pPrev=pFlatRoot->pBranch
pTemp1->BranchCount=pFlatRoot->pBranch->BranchCount : uNodeCOUNT-=pFlatRoot->pBranch->BranchCount 'this.FlatCount :
this.pFlatRoot->pBranch->BranchCount=0 : If pFirstNode->pBranch=pFlatRoot Then : uCount=0 : End If ' this.FlatStack : uCount=0
Return pTemp1
End Property
Property List.GiveGarbage As ListNode Ptr
Dim As ListNode Ptr pTemp1, pTemp2
If uGarbCt<2 Then : Return 0 : End If : pTemp1=pFlatRoot->pNext : pTemp2=pGarbage->pPrev : If pTemp1=pTemp2 Then : Return 0 : End If
pFlatRoot->pNext=pGarbage : pGarbage->pPrev=pFlatRoot : pTemp1->pBranch=pTemp2 : pTemp1->BranchCount=uGarbCt
uNodeCOUNT-= uGarbCt : uGarbCt=0
Return pTemp1
End Property
Property List.GivePanCake As ListContainer Ptr
Dim As ListContainer Ptr pPanTemp1, pPanTemp2
If uContainerGarbCt<2 Then : Return 0 : End If : pLastPanCake=0
pPanTemp1=pPanCakeGarbage->pNextContainer : pPanTemp2=pPanTemp1
While pPanTemp2->pNextContainer<>pPanCakeGarbage : pPanTemp2=pPanTemp2->pNextContainer : Wend : pPanTemp2->pNextContainer=0 : pLastPanCake=pPanTemp2
pPanCakeGarbage->pNextContainer=pPanCakeGarbage : uContainerGivenCt=uContainerGarbCt : uContainerGarbCt=0
Return pPanTemp1
End Property
Property List.GiveLastPanCake As ListContainer Ptr : Return pLastPanCake : End Property
Property List.GivePanCakeCount As uInteger : Return this.uContainerGivenCt : End Property
'==========================================================================================TYPE LIST PUBLIC PROPERTIES - FLAT CONTROL
Property List.Tag(str_Tag As String) As Byte
Dim pTemp As ListNode Ptr : Dim item As ListContainer Ptr
If this.sSearchTag = str_Tag Then
If this.bSearchRes=1 Then
this.pNode = this.pSearchNode : Return 1 'pNode
Else
pTemp = this.pLastNode : this.uCount+=1 : pTemp->pNext = this.AllowCake 'And eat it
pTemp->pNext->pPrev = pTemp : pTemp->pNext->Tag(uTag) = str_Tag ' pTemp->pNext->ListData = item :
pTemp = pTemp->pNext : this.pLastNode = pTemp : If bBranchCountDown=1 Then : this.BCountDown(1) : End If
this.pNode = pTemp : Return 0
End If
Else
If this.bSeekMethod=1 Then : pTemp = this.pFirstNode : If this.pGarbage<>0 And this.pFirstNode=this.pFirstFIRSTNode Then : pTemp = this.pGarbage : End If
While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag) : pTemp = pTemp->pNext : Wend
ElseIf this.bSeekMethod=2 Then : pTemp = this.pLastNode
While (pTemp->pPrev <> 0 And pTemp->Tag(uTag) <> str_Tag AND pTemp <> this.pGarbage ) : pTemp = pTemp->pPrev : Wend
Else
pTemp = this.pNode : If pTemp->pNext <> 0 Then : pTemp = pTemp->pNext : End If
While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag) : pTemp = pTemp->pNext : Wend
End If
If pTemp->Tag(uTag)<>str_Tag then ' New node
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 : If bBranchCountDown=1 Then : this.BCountDown(1) : End If
If pFirstNode=pFirstFIRSTNode And pWhyteMove<>0 And pWhyteMove<>pLastNode Then
If pWhyteMove->pNext<>0 Then 'Changement de fonctionnement - Patch de compatibilité - dernier node logique à blanc
pWhyteMove->pPrev->pNext=pWhyteMove->pNext : pWhyteMove->pNext->pPrev=pWhyteMove->pPrev : pLastNode->pNext=pWhyteMove : pWhyteMove->pPrev=pLastNode : pLastNode=pWhyteMove : pLastNode->pNext=0
End If
End If : this.pNode = pTemp : Return 0
End If
End If
this.pNode = pTemp : Return 1 'pTemp
End Property
Property List.Tag As String
If uTag<=RUP_COLS Then : Return this.pNode->Tag(uTag)
ElseIf pNode->ListData=0 Then : Return ""
Else : Return pNode->ListData->str_tag_C(uTag)
End If
End Property
Property List.Tag(i As Integer) As String
If i<=RUP_COLS Then : Return this.pNode->tag(i) : Else : If pNode->ListData<>0 Then : Return pNode->ListData->str_tag_C(i) : Else : Return "" : End If : End If
End Property
Property List.HasTag(str_Tag As String) As Byte
Dim pTemp As ListNode Ptr
this.sSearchTag = str_Tag
If this.bSeekMethod=1 Then
pTemp = this.pFirstNode : If this.pGarbage<>0 And this.pFirstNode=this.pFirstFIRSTNode Then : pTemp = this.pGarbage : End If
While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag AND pTemp <> this.pLastNode ) : pTemp = pTemp->pNext : Wend
ElseIf this.bSeekMethod=2 Then
pTemp = this.pLastNode
While (pTemp->pPrev <> 0 And pTemp->Tag(uTag) <> str_Tag AND pTemp <> this.pGarbage ) : pTemp = pTemp->pPrev : Wend
Else
pTemp = this.pNode : If pTemp=0 Then : pTemp = this.pFirstNode : End If
If pTemp->pNext <> 0 Then : pTemp = pTemp->pNext : End If
While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag AND pTemp <> this.pLastNode ) : pTemp = pTemp->pNext : Wend
End If
If pTemp->Tag(uTag) = str_Tag Then
this.pSearchNode=pTemp : this.bSearchRes=1 : If this.bAutoCursor=1 Then : pNode=pTemp : End If : Return 1
Else : this.bSearchRes = 0 : Return 0 : End If
End Property
Property List.BlindTag(str_Tag As String) As Byte
Dim pTemp As ListNode Ptr : Dim item As ListContainer
pTemp = this.pLastNode : this.uCount+=1 : pTemp->pNext = this.AllowCake 'And eat it
pTemp->pNext->pPrev = this.pLastNode : pTemp->pNext->Tag(uTag) = str_Tag
pTemp = pTemp->pNext : this.pLastNode = pTemp : this.pNode = pTemp
If bBranchCountDown=1 Then : this.BCountDown(1) : End If : Return 1
End Property
Property List.RwTag(s_Tag As String) As Byte : If uTag<=RUP_COLS Then : this.pNode->tag(this.uTag)=s_Tag : Return 1 : Else : If pNode->ListData=0 Then : this.pValTmp=this.pNode : this.ValPrivate("") : End If : pNode->ListData->str_tag_C(uTag)=s_Tag : Return 1 : End If : End Property
Property List.RwTag1(s_Tag As String) As Byte : this.pNode->tag(1)=s_Tag : Return 1 : End Property
Property List.RwTag2(s_Tag As String) As Byte : If pNode->ListData=0 Then : this.pValTmp=this.pNode : this.ValPrivate("") : End If : pNode->ListData->str_tag_C(2)=s_Tag : Return 1 : End Property
Property List.RwTag3(s_Tag As String) As Byte : If pNode->ListData=0 Then : this.pValTmp=this.pNode : this.ValPrivate("") : End If : pNode->ListData->str_tag_C(3)=s_Tag : Return 1 : End Property
Property List.RwTag4(s_Tag As String) As Byte : If pNode->ListData=0 Then : this.pValTmp=this.pNode : this.ValPrivate("") : End If : pNode->ListData->str_tag_C(4)=s_Tag : Return 1 : 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.ColTags(i as Byte) As Byte : this.sSearchTag = "" : this.bSearchRes=0 : If i > MAX_COLS-1 then : this.uTag=MAX_COLS-1 : Return 0 : Else : this.uTag=i : Return 1 : End If : End Property
Property List.SeekMethod(i as Byte) As Byte : If i=0 Or i=1 Or i=2 Then : this.bSeekMethod=i : Return 1 : Else : Return 0 : End If : End Property
Property List.AllOf As uInteger
Dim pContextRetour As ListContext
Dim As ListNode Ptr pTemp, pTemp2 : If bTracking=1 Then : this.TrackCompute : bTracking=0 : End If
If pFirstNode=pFIRSTFIRSTNode Then : If pLastNode<>pWhyteMove Then : this.Root : End If : End If
this.NodeRecycle : this.NodeRecycle2
pContextRetour.pNode=pNode : pContextRetour.pFirstNode=This.pFirstNode : pContextRetour.pLastNode=This.pLastNode : pContextRetour.uCount=This.uCount
this.AllOfPrivate
pNode=pContextRetour.pNode : This.pFirstNode=pContextRetour.pFirstNode : This.pLastNode=pContextRetour.pLastNode : uCount=pContextRetour.uCount
pNode=AllowCake : pLocalMove=pNode
If this.pFirstNode=this.pFirstFIRSTNode Then : pNode->pNext=pGarbage->pNext : Else : pNode->pNext=pFirstNode->pNext : End If
If pLastNode=pWhyteMove And pLastNode->pPrev<>0 Then : pNode->pPrev=pLastNode->pPrev : Else : pNode->pPrev=pLastNode : End If
Return this.Count
End Property
Property List.Count As uInteger : If pWhyteMove=pLastNode And pFirstNode=this.pFirstFIRSTNode Then : Return this.uCount-1 : End If : Return this.uCount : End Property
Property List.First As Byte : If pFirstNode=pFirstFIRSTNode Then : pNode=pGarbage : Else : this.pNode=This.pFirstNode->pNext : End If : Return 1 : End Property
Property List.Last As Byte : this.pNode=This.pLastNode : Return 1 : End Property
Property List.Val(str_value As String) As Byte : this.pValTmp=this.pNode : this.ValPrivate(str_value) : Return 1 : End Property
Property List.Val As String : pValTmp=pNode : Return this.ValPrivate : End Property
Property List.ValTag(str_value As String) As String
If bSearchRes=1 Then : If str_value=this.Tag(0) Then : pValTmp=pSearchNode : Return this.ValPrivate : End If
ElseIf this.HasTag(str_value)=1 Then : pValTmp=pSearchNode : Return this.ValPrivate
End If : Return("")
End Property
Property List.fStep As Byte : If pNode=pLastNode Or bfStepZero=1 Or pNode->pNext=pWhyteMove Then : bfStepZero=0 : Return 0 : Else : pNode = pNode->pNext : Return 1 : End If : End Property '
Property List.fStepRev As Byte : If pNode->pPrev=pFirstNode Or pNode->pPrev=pGarbage Or bfStepZero=1 Then : bfStepZero=0 : Return 0 : Else : pNode = pNode->pPrev : Return 1 : End If : End Property
Property List.bStep As Byte : this.pNode = this.pNode->pNext : Return 1 : End Property
Property List.BlindStep As Byte : If this.pNode->pNext<>0 Then : this.pNode = this.pNode->pNext : Return 1 : Else : Return 0 : End If : End Property ' : Print "*Warning : list parse or count down error"
Property List.BlindStep(top As Integer) As Byte
Dim As Integer i : Dim As Byte istep
If top>0 Then : istep=1 : For i=1 To top step istep : this.pNode = this.pNode->pNext : Next i : ElseIf top = 0 Then : this.pNode = this.pLastNode : Return 1 : Else : istep=-1 : For i=-1 To top step istep : this.pNode = this.pNode->pPrev : Next i : End If
Return 1
End Property
Property List.fMove(nbMove As Integer) As Byte
Dim As ListNode Ptr pFirst, pTemp : Dim i As Integer=0
If pFirstNode=pFirstFIRSTnode Then : pFirst=pGarbage : Else : pFirst=pFirstNode : End If
If pNode=pLastNode Then : pLastNode=pNode->pPrev : Else : pNode->pNext->pPrev=pNode->pPrev : End If
pNode->pPrev->pNext=pNode->pNext : pTemp=pNode
If nbMove>0 Then : For i=0 To nbMove : If pNode<>pLastNode Then : pTemp=pTemp->pNext : End If : Next i
Else : For i=nbMove To 0 : If pTemp<>pFirstNode Then : pTemp=pTemp->pPrev : End If : Next i
End If
If pTemp<>pLastNode Then : pTemp->pNext->pPrev=pNode : pNode->pNext=pTemp->pNext
Else : If pTemp->pNext<>0 Then : pNode->pNext=pTemp->pNext : End If : pLastNode=pNode
End If
pTemp->pNext=pNode : pNode->pPrev=pTemp
Return 1
End Property
'==========================================================================================TYPE LIST PUBLIC PROPERTIES - HASH CONTROL
Property List.Root As Byte
Dim pTemp As ListNode Ptr : Dim pTemp2 As ListNode Ptr : Dim pContextRetour As ListContext
If bTracking=1 Then : this.TrackCompute : bTracking=0 : End If :' this.pFirstNode->BranchCount = this.uCount : this.pFirstNode->pBranchLastNode = this.pLastNode
this.NodeRecycle : this.RootPrivate : this.NodeRecycle2 : bSearchRes=0 : pTemp2=0 : this.bHashStepRev=0
'Changement de fonctionnement - Patch de compatibilité - : il faut un dernier node logique à blanc qui ne soit jamais 'flaté'
If this.pWhyteMove<>0 Then
If this.pWhyteMove->pNext<>0 And pWhyteMove->pNext->Tag(0)<>LIST_RES Then
If pWhyteMove->pPrev<>0 Then : this.pWhyteMove->pPrev->pNext=this.pWhyteMove->pNext : End If
If pWhyteMove->pNext<>0 Then :this.pWhyteMove->pNext->pPrev=this.pWhyteMove->pPrev : End If
End If
End If
If pPanCakeGarbage=0 Then : pPanCakeGarbage=AllowPanCake : pPanCakeGarbage->pNextContainer=pPanCakeGarbage : End If
If pGarbage=0 Then ' This.Tag(LIST_DEL) :
This.BlindTag(LIST_DEL) : pGarbage=this.pNode : this.Val(LIST_DEL) : pGarbage->pPrev=pFlatRoot
If pFlatRoot->pNext<>pGarbage Then : pGarbage->pNext=pFlatRoot->pNext : End If : pFlatRoot->pNext=pGarbage
If pGarbage->pNext<>0 Then : pGarbage->pNext->pPrev=pGarbage : End If : this.pNode = pGarbage
End If
'Gestion du contexte de la Flat List qui doit contenir un dernier node à blanc
this.FlatStack(0)
'Corrections - Patch de compatibilité - : pFlatRoot se balade, il faut le remettre au début -
If pFlatRoot->pPrev<>0 Then : pFlatRoot->pPrev->pNext=pFlatRoot->pNext : End If : If pFlatRoot->pNext<>0 Then : pFlatRoot->pNext->pPrev=pFlatRoot->pPrev : End If
pFlatRoot->pPrev=this.pFirstFIRSTNode : pFlatRoot->pNext=this.pFirstFIRSTNode->pNext : If this.pFirstFIRSTNode->pNext<>0 Then : this.pFirstFIRSTNode->pNext->pPrev=pFlatRoot : End If : this.pFirstFIRSTNode->pNext=pFlatRoot
'Changement de fonctionnement - Patch de compatibilité - pLastLAST devient dernier node LOGIQUE : on le remet à jour
If this.pFirstFIRSTNode->pBranchLastNode<>0 Then
pTemp=this.pFirstFIRSTNode->pBranchLastNode : While pTemp->pBranchLastNode<>0 And pTemp<>pTemp2 : pTemp2=pTemp : pTemp=pTemp->pBranchLastNode : Wend : this.pLastLASTNode=pTemp
End If
'NodeFlat+Restorehash nécessite la présence d'un dernier node fictif
If this.pLastNode->Tag(0)<>"" Then : If pWhyteMove<>0 Then : this.AllOf : Else : pTemp=this.pNode : this.pFirstNode->BranchCount=this.uCount : this.BlindTag("") : this.pWhyteMove=this.pNode : this.pNode=pTemp : End If : End If
' If this.pLastNode->Tag(0)<>"" Then : pTemp=this.pNode : this.pFirstNode->BranchCount=this.uCount : this.BlindTag("") : this.pWhyteMove=this.pNode : this.pNode=pTemp : End If
this.pNode=pGarbage : this.uCount=this.pFirstFIRSTNode->BranchCount : this.pLastLASTNode->pPrev->pNext=this.pLastLASTNode
If this.pLastLASTNode->pNext->Tag(0)=LIST_RES Then : this.pLastLASTNode->pNext=0 : End If
' Option for .Root become compatible with Rev parse with no need to jump to Last node (List.Last)
this.pNode=AllowCake : pNode->Tag(0)="" : pLocalMove=pNode : pNode->pNext=pGarbage->pNext
If pLastNode=pWhyteMove Then : pNode->pPrev=pLastNode->pPrev : Else : pNode->pPrev=pLastNode : End If
this.NodeRecycle2 : this.pFirstNode->BranchCount=this.uCount : this.pFirstNode->pBranchLastNode=this.pLastNode
Return 1
End Property
Property List.FlatStack As Byte : this.FlatStack(1) : this.AllOf : bSearchRes=0 : Return 1 : End Property
Property List.RootNode As Byte : bSearchRes=0 : this.Root : this.pNode=This.pFirstFIRSTNode : Return 1 : End Property
Property List.EndNode As Byte : bSearchRes=0 : this.Root : this.pNode=This.pLastLASTNode : Return 1 : End Property
Property List.HashStep As Byte
While this.pnode->pBranch<>0
this.pFirstNode=this.pNode->pBranch : this.uCount=this.pFirstNode->BranchCount '
this.pLastNode=this.pNode->pBranch->pBranchLastNode : this.pNode=this.pNode->pBranch
If pnode<>pLastNode Then : pnode=pnode->pNext : If pNode=pWhyteMove Then : this.AllOf : Return 0 : Else : Return 1 : End If : End If ' If pNode=pWhyteMove Then : Return 0 : Else : Return 1 : End If
Wend : If pnode<>pLastNode Then : pnode=pnode->pNext : If pNode=pWhyteMove Then : this.AllOf : Return 0 : Else : Return 1 : End If : End If
While pFirstNode->pBranch<>0
pNode=pFirstNode->pBranch : pFirstNode=pFirstNode->pPrev : uCount=pFirstNode->BranchCount
pLastNode=pFirstNode->pBranchLastNode : If pnode<>pLastNode Then : pnode=pnode->pNext : If pNode=pWhyteMove Then : this.AllOf : Return 0 : Else : Return 1 : End If : End If
Wend : this.RootPrivate : Return 0
End Property
Property List.HashStepRev As Byte
this.bHashStepRev=1
While this.pnode->pBranch <> 0
this.pFirstNode=this.pNode->pBranch : this.uCount=this.pFirstNode->BranchCount
this.pLastNode=this.pNode->pBranch->pBranchLastNode : this.AllOf : If this.pnode <> this.pFirstNode->pNext And pnode->pPrev->Tag(0)<>LIST_RES Then : this.pnode = this.pnode->pPrev : Return 1 : End If
Wend : If pnode->pPrev=pGarbage Then : Return 0 : End If : If pnode->pPrev<>pFirstNode And pnode->pPrev->Tag(0)<>LIST_RES Then : this.pnode = this.pnode->pPrev : Return 1 : End If
While pFirstNode->pBranch<> 0
pNode=pFirstNode->pBranch :' pFirstNode->BranchCount=uCount : pFirstNode->pBranchLastNode=pLastNode :
pFirstNode=pFirstNode->pPrev : uCount=pFirstNode->BranchCount
pLastNode=pFirstNode->pBranchLastNode : If this.pnode <> this.pFirstNode->pNext And pnode->pPrev->Tag(0)<>LIST_RES Then : this.pnode = this.pnode->pPrev : If pnode=pGarbage Then : Return 0 : End If : Return 1 : End If
Wend : Return 0
End Property
Property List.KeyStep As Byte : While this.HashStep=1 : If pNode->Tag(1)<>"" And pNode->Tag(1)<>LIST_DEL Then : Return 1 : End If : Wend : End Property
Property List.KeyStepRev As Byte : While this.HashStepRev=1 : If pNode->Tag(1)<>"" And pNode->Tag(1)<>LIST_DEL Then : Return 1 : End If : Wend : End Property