Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
linkedlist.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 25.04.2008 01:06:13 |
'##############################################################################################################
' LinkedList
' By.: Martin Wiemann
' Date: 23.03.2008 - 14:23
'##############################################################################################################
#include once "crt/string.bi"
'##############################################################################################################
Function ColCreate() as Integer PTR
Dim CID as Integer PTR = ALLOCATE(SizeOf(Integer) * 3)
If CID = 0 Then Return 0
CID[0] = 0: CID[1] = 0: CID[2] = 0
Return CID
End Function
'##############################################################################################################
Function ColDestroy(ByRef V_Collection as Integer PTR) as UByte
If V_Collection = 0 Then Return 2
Dim NID as Integer PTR = V_Collection
V_Collection = 0
Dim AID as Integer PTR
Do
If NID = 0 Then Exit Do
AID = Cast(Integer PTR, NID[2]): NID[2] = 0
If NID[1] <> 0 Then DEALLOCATE(Cast(Integer PTR, NID[1])): NID[1] = 0
DEALLOCATE(NID)
NID = AID
Loop
Return 0
End Function
'##############################################################################################################
Function ColGetItemX(ByRef V_Collection as Integer PTR, V_Item as UInteger) as Integer PTR
If V_Collection = 0 Then Return 0
If V_Item < 0 Then Return 0
Dim NID as Integer PTR = V_Collection
Dim X as UInteger
Do
If NID = 0 Then Exit Do
X += 1
If X = V_Item Then Return NID
NID = Cast(Integer PTR, NID[2])
Loop
Return 0
End Function
'##############################################################################################################
Declare Function ColSet Overload (ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as Integer) as UByte
Declare Function ColSet (ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as UInteger) as UByte
'##############################################################################################################
Function ColSet(ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as Integer) as UByte
If V_Collection = 0 Then Return 2
If V_Item < 0 Then Return 3
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
Dim AID as Integer PTR = Cast(Integer PTR, NID[1])
If AID = 0 Then
AID = Allocate(SizeOf(V_Value))
Else: AID = REALLOCATE(AID, SizeOf(V_Value))
End If
NID[1] = Cast(Integer, AID)
*AID = V_Value
Return 0
End Function
'--------------------------------------------------------------------------------------------------------------
Function ColSet(ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as String) as UByte
If V_Collection = 0 Then Return 2
If V_Item < 0 Then Return 3
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
Dim AID as String PTR = Cast(String PTR, NID[1])
If AID = 0 Then
AID = Allocate(Len(V_Value))
Else: AID = REALLOCATE(AID, Len(V_Value))
End If
NID[1] = Cast(Integer, AID)
*AID = V_Value
Return 0
End Function
'##############################################################################################################
Function ColGetInt(ByRef V_Collection as Integer PTR, V_Item as UInteger) as Integer
If V_Collection = 0 Then Return 0
If V_Item < 0 Then Return 0
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
If NID <> 0 Then
Return *Cast(Integer PTR, NID[1])
Else: Return 0
End If
End Function
'--------------------------------------------------------------------------------------------------------------
Function ColGetIntPTR(ByRef V_Collection as Integer PTR, V_Item as UInteger) as Integer PTR
If V_Collection = 0 Then Return 0
If V_Item < 0 Then Return 0
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
If NID <> 0 Then
Return Cast(Integer PTR, NID[1])
Else: Return 0
End If
End Function
'--------------------------------------------------------------------------------------------------------------
Function ColGetStr(ByRef V_Collection as Integer PTR, V_Item as Integer) as String
If V_Collection = 0 Then Return ""
If V_Item < 0 Then Return ""
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
If NID <> 0 Then
Dim XLen as Integer ptr = Cast(Integer ptr, NID[1])
Dim T as String = Space(*XLen)
memcpy(strptr(T), Cast(integer ptr, NID[1]) + 1 , *XLen)
Return T
Else: Return ""
End If
End Function
'##############################################################################################################
Declare Function ColAdd Overload (ByRef V_Collection as Integer PTR, V_Value as Integer, V_ToItem as UInteger = -1) as UByte
Declare Function ColAdd Overload (ByRef V_Collection as Integer PTR, V_Value as Integer PTR, V_ToItem as UInteger = -1) as UByte
Declare Function ColAdd (ByRef V_Collection as Integer PTR, V_Value as String, V_ToItem as UInteger = -1) as UByte
'##############################################################################################################
Function ColAddX(ByRef V_Collection as Integer PTR, V_ToItem as UInteger = -1) as Integer PTR
If V_Collection = 0 Then
V_Collection = ColCreate()
If V_Collection = 0 Then Return 0
Return V_Collection
End if
Dim NID as Integer PTR = V_Collection
If NID[1] = 0 Then Return NID
Dim AID as Integer PTR
Dim LID as Integer PTR
Dim X as UInteger
If V_ToItem = cast(integer, -1) Then
LID = Cast(Integer PTR, NID[0])
If LID = 0 Then LID = NID
NID = 0
End If
Do
If NID = 0 Then
AID = ALLOCATE(SizeOf(Integer) * 3)
If AID = 0 Then Return 0
AID[0] = Cast(Integer, LID)
AID[2] = 0
If LID <> 0 Then LID[2] = Cast(Integer, AID)
V_Collection[0] = Cast(Integer, AID)
Return AID
End If
X += 1
If X >= V_ToItem Then
AID = ALLOCATE(SizeOf(Integer) * 3)
If AID = 0 Then Return 0
AID[0] = Cast(Integer, LID)
AID[2] = Cast(Integer, NID)
If NID <> 0 Then NID[0] = Cast(Integer, AID)
If LID <> 0 Then LID[2] = Cast(Integer, AID)
Return AID
End If
LID = NID
NID = Cast(Integer PTR, NID[2])
Loop
Return 0
End Function
'##############################################################################################################
Function ColAdd(ByRef V_Collection as Integer PTR, V_Value as Integer, V_ToItem as UInteger = -1) as UByte
Dim NID as Integer PTR = ColAddX(V_Collection, V_ToItem)
If NID = 0 Then Return 1
Dim TID as Integer PTR
TID = Allocate(sizeof(integer))
*TID = V_Value
NID[1] = Cast(Integer, TID)
Return 0
End Function
'--------------------------------------------------------------------------------------------------------------
Function ColAdd(ByRef V_Collection as Integer PTR, V_Value as Integer PTR, V_ToItem as UInteger = -1) as UByte
Dim NID as Integer PTR = ColAddX(V_Collection, V_ToItem)
If NID = 0 Then Return 1
Dim TID as Integer PTR
TID = Allocate(sizeof(integer ptr))
TID = V_Value
NID[1] = Cast(Integer, TID)
Return 0
End Function
'--------------------------------------------------------------------------------------------------------------
Function ColAdd(ByRef V_Collection as Integer PTR, V_Value as String, V_ToItem as UInteger = -1) as UByte
Dim NID as Integer PTR = ColAddX(V_Collection, V_ToItem)
If NID = 0 Then Return 1
Dim TID as Integer PTR
TID = Allocate(Len(V_Value) + sizeof(integer))
*Cast(integer ptr, TID) = Len(V_Value)
memcpy(TID + 1, strptr(V_Value), Len(V_Value))
NID[1] = Cast(Integer, TID)
Return 0
End Function
'##############################################################################################################
Function ColDel(ByRef V_Collection as Integer PTR, V_Item as UInteger) as UByte
If V_Collection = 0 Then Return 2
Dim NID as Integer PTR = V_Collection
Dim TID as Integer PTR
Dim X as UInteger
Do
If NID = 0 Then Return 4
X += 1
If X >= V_Item Then
If NID[2] = 0 Then V_Collection[0] = NID[0]
TID = Cast(Integer PTR, NID[1]): If TID <> 0 Then DEALLOCATE(TID): NID[1] = 0
TID = Cast(Integer PTR, NID[0]): If TID <> 0 Then TID[2] = NID[2]: NID[2] = 0
TID = Cast(Integer PTR, NID[2]): If TID <> 0 Then TID[0] = NID[0]: NID[0] = 0
DEALLOCATE(NID)
Return 0
End If
NID = Cast(Integer PTR, NID[2])
Loop
Return 4
End Function
'##############################################################################################################
Function ColCount(ByRef V_Collection as Integer PTR) as UInteger
If V_Collection = 0 Then Return 0
Dim NID as Integer PTR = V_Collection
Dim X as UInteger = 0
Do
If NID = 0 Then Exit Do
X += 1: NID = Cast(Integer PTR, NID[2])
Loop
Return X
End Function
'##############################################################################################################
Declare Function ColFind Overload (ByRef V_Collection as Integer PTR, V_Match as Integer) as UInteger
Declare Function ColFind (ByRef V_Collection as Integer PTR, V_Match as String) as UInteger
'##############################################################################################################
Function ColFind(ByRef V_Collection as Integer PTR, V_Match as Integer) as UInteger
If V_Collection = 0 Then Return 0
Dim NID as Integer PTR = V_Collection
Dim AID as Integer PTR
Dim X as UInteger
Do
If NID = 0 Then Exit Do
X += 1
AID = Cast(Integer PTR, NID[1])
If *AID = V_Match Then Return X
NID = Cast(Integer PTR, NID[2])
Loop
Return 0
End Function
'--------------------------------------------------------------------------------------------------------------
Function ColFind(ByRef V_Collection as Integer PTR, V_Match as String) as UInteger
If V_Collection = 0 Then Return 0
Dim NID as Integer PTR = V_Collection
Dim X as UInteger
Dim T as String
Do
If NID = 0 Then Exit Do
X += 1
Dim XLen as Integer ptr = Cast(Integer ptr, NID[1])
T = Space(*XLen)
memcpy(strptr(T), Cast(integer ptr, NID[1]) + 1 , *XLen)
If T = V_Match Then Return X
NID = Cast(Integer PTR, NID[2])
Loop
Return 0
End Function