Collection

Collection.lss

%REM
	Class CollectionItem
	Enumerable object to be used in collections
	
	@author Jiri Krakora aka Lokutus
	@date 28.3.2012
	@revision 1.0 Release
%END REM
Public Class CollectionItem
	Private oID As String
	
	Public Property Set ID As String
		Let Me.oID = ID
	End Property
	
	Public Property Get ID As String
		Let ID = Me.oID
	End Property
	
	Public Function ToString As String
		Let ToString = Me.oID
	End Function
End Class

%REM
	Class Collection
	Generic objects Collection class
	Can be used any user-defined objects, but must extend CollectionItem class
		or must have a get/set property ID of type string
	
	@author Jiri Krakora aka Lokutus
	@date 28.3.2012
	@uses CollectionItem
	@revision 1.0 Release
	
	Example
	----------------------------------------------------------------------------
	Dim item As CollectionItem
	Dim col As New Collection
	Dim i As Integer
	
	For i = 1 To 10
		Set item = New CollectionItem
		Let item.ID = CStr(i)
		Call col.Add(item)
	Next
	
	While col.MoveNext
		Print col.Current.ToString
	Wend
%END REM
Public Class Collection
	Private oCollection List As Variant		' Items collection
	Private oIndex List As String			' Index of the collection for faster lookup
	Private oCount As Long					' Count of the whole items stack
	Private oCurrent As Variant				' Current object set by MoveNext()
	Private oCurrentIndex As Long			' Index of the Current object
	Private oUpperBound As Long				' Index number of the last added item 
	
	Public Property Get Count As Long
		Let Count = Me.oCount
	End Property
	
	Public Property Get UpperBound As Long
		Let UpperBound = Me.oUpperBound
	End Property
	
	Public Property Get Current As Variant
		Set Current = Me.oCurrent
	End Property
	
	Public Sub New
		Set Me.oCurrent = Nothing
		Let Me.oCount = 0
		Let Me.oUpperBound = -1
	End Sub
	
	%REM
		Return true/false if object list is empty
		@return true/false
	%END REM
	Public Property Get IsEmpty As Boolean
		Let ~IsEmpty = True
		
		ForAll item In Me.oCollection
			Let ~IsEmpty = False
			Exit Property
		End ForAll
	End Property
	
	%REM
		Return index of the collection item via item ID
		If there is no item ID in the collection, returns -1
		@return index as Long
	%END REM
	Public Property Get IndexOf(id As String) As Long
		ForAll item In Me.oIndex
			If item = id Then
				Let IndexOf = ListTag(item)
				Exit Property
			End If
		End ForAll
		
		Let IndexOf = -1
	End Property
	
	%REM
		Check Collection if there is an item with specified ID
		@param item ID
		@return true/false
	%END REM
	Public Property Get Contains(id As String) As Boolean
		If IsElement(Me.oCollection(id)) Then
			Let Contains = True
		End If
	End Property
	
	%REM
		Add new CollectionItem based object into collection
		@param user defined object, must extend CollectionItem class
	%END REM
	Public Sub Add(item As Variant)
		If Me.AddItemIntoCollection(item) Then
			Let Me.oUpperBound = Me.oUpperBound + 1		' increment upper bound of the collection
			Let Me.oCount = Me.oCount + 1				' increment count of items
			Let Me.oIndex(Me.oUpperBound) = item.ID		' set index
		End If
	End Sub
	
	%REM
		Insert new CollectionItem based object into collection onto specified position
		@param user defined object, must extend CollectionItem class
		@param index of the position to move item onto
	%END REM
	Public Sub Insert(item As Variant, ByVal index As Long)
		Dim i As Long
		
		' Check index constraints
		If index < 0 Then Let index = 0
		If index > Me.oUpperBound Then
			Call Me.Add(item)
			Exit Sub
		End If
		
		If Me.AddItemIntoCollection(item) Then
			' Rebuild index
			For i = Me.oUpperBound To index Step -1
				Let Me.oIndex(i + 1) = Me.oIndex(i)
			Next
			
			Let Me.oUpperBound = Me.oUpperBound + 1		' increment upper bound of the collection
			Let Me.oCount = Me.oCount + 1				' increment count of items
			Let Me.oIndex(index) = item.ID				' set index
		End If
	End Sub
	
	%REM
		Only add item into collection
		@param item
		@return true/false
	%END REM
	Private Function AddItemIntoCollection(item As Variant) As Boolean
		On Error 182 GoTo eh182					' when asking for property ID
		On Error GoTo eh
		
		If DataType(item) = 34 Then				' is it user defined object?
			If Not item Is Nothing Then			' is it instantiated?
				If DataType(item.ID) = 8 Then	' is property ID string?
					If item.ID = "" Then		' if ID is empty, create unique one
						Let item.ID = Me.GetUniqueItemID
					End If
					
					If Not IsElement(Me.oCollection(item.ID)) Then
						Set Me.oCollection(item.ID) = item
						Let AddItemIntoCollection = True
					End If
				End If
			End If
		End If
		
es:
		Exit Function
eh182:
		Resume es
eh:
		Resume es
	End Function
	
	%REM
		Remove collection member via it's ID
		If there is no such a member, no action will be taken
		@param object ID
	%END REM
	Public Sub Remove(id As String)
		Dim i As Long
		Dim index As Long
		On Error 120 GoTo eh120			' List item does not exist
		On Error GoTo eh
		
		' erase collection item
		Erase Me.oCollection(id)
		Let Me.oCount = Me.oCount - 1
		
		' get index of the collection item
		Let index = Me.IndexOf(id)
		
		' rebuild index
		For i = index To Me.oUpperBound - 1
			Let Me.oIndex(i) = Me.oIndex(i + 1)
		Next
		Erase Me.oIndex(Me.oUpperBound)
		Let Me.oUpperBound = Me.oUpperBound - 1
		Set Me.oCurrent = Nothing
		Let Me.oCurrentIndex = 0
es:
		Exit Sub
eh120:
		Resume es
eh:
		Resume es
	End Sub
	
	%REM
		Return collection member via it's ID
		If there is no such a member Nothing is returned
		@param object ID
		@return object
	%END REM
	Public Function Get(id As String) As Variant
		On Error 120 GoTo eh120			' List item does not exist
		
		Set ~Get = Me.oCollection(id)
es:
		Exit Function
eh120:
		Set ~Get = Nothing				' return at least Nothing (datatype 9)
		Resume es
	End Function
	
	%REM
		Move caret to the next item in the collection and put it into Current
		If there are no elements in collection or collection is at the end
			false id returned and Nothig is being put into Current object
		using:
			While col.MoveNext()
				Set item = col.Current
			Wend
		@return true/false
	%END REM
	Public Function MoveNext As Boolean
		Dim id As String
		On Error 120 GoTo eh120			' List item does not exist
		
		Let id = Me.oIndex(Me.oCurrentIndex)
		Set Me.oCurrent = Me.oCollection(id)
		Let Me.oCurrentIndex = Me.oCurrentIndex + 1
		Let MoveNext = True
		Exit Function
es:
		Set Me.oCurrent = Nothing
		Exit Function
eh120:
		Resume es
	End Function
	
	%REM
		Reset Current object to a default state
	%END REM
	Public Sub Reset
		Let Me.oCurrentIndex = 0
		Set Me.oCurrent = Nothing
	End Sub
	
	%REM
		Reset Collection
		Erase all items, set count to zero, set Current to nothing, reset indexes
		@param
	%END REM
	Public Sub Clear
		Erase Me.oCollection
		Erase Me.oIndex
		Let Me.oCount = 0
		Let Me.oUpperBound = -1
		Let Me.oCurrentIndex = 0
		Set Me.oCurrent = Nothing
	End Sub
	
	%REM
		Return Collection as an array
		If count is bigger then 32kB, return only 32k items
		@return array of collection items
	%END REM
	Public Function ToArray As Variant
		Dim index As Long
		Dim array() As Variant
		
		If Me.oCount > 32000 Then
			ReDim array(32000)
		Else
			ReDim array(Me.oCount - 1)
		End If
		
		ForAll item In Me.oCollection
			If index < 32001 Then
				Set array(index) = item
			End If
			
			Let index = index + 1
		End ForAll
		
		Let ToArray = array
	End Function
	
	%REM
		Return current object as string
		@return string
	%END REM
	Public Function ToString As String
		Let ToString = TypeName(Me)
	End Function
	
	%REM
		Return unique ID
		@return unique ID
	%END REM
	Private Function GetUniqueItemID As String
		Dim eval As Variant
		
		Let eval = Evaluate(|@RightBack(@Unique; "-") + @LeftBack(@Unique; "-") + @RightBack(@Unique; "-")|)
		Let GetUniqueItemID = eval(0)
	End Function
End Class