Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Sparse Array Map

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Sparse Array Map

    Library.inc - General include file so you can tell what the classes do

    Code:
    INTERFACE IMapHWndToObject GUID$("{A9A0FCE8-3402-4F60-A46E-2C458869A064}")
        INHERIT IUNKNOWN
        PROPERTY GET ITEM(hWnd AS DWORD) AS IUNKNOWN
        PROPERTY SET ITEM(hWnd AS DWORD, value AS IUNKNOWN)
        METHOD Remove(hWnd AS DWORD)
        METHOD CLEAR()
    END INTERFACE
    DECLARE FUNCTION NewMapHWndToObject() COMMON AS IMapHWndToObject
    Map.bas - The SLL file that impelements a sparse array.

    Code:
    #Compile SLL
    #Dim All
    #Include "Library.inc"
     
    Class Node256 Common
      Instance objs() As IUnknown
      Class Method Create()
        ReDim objs(256)
        Call Me.ClearList()
      End Method
      Class Method Destroy()
        Call ME.ClearList()
      End Method
      Class Method ClearList()
        Local i As Long
        For i=0 To 255
          objs(i) = Nothing
        Next
      End Method
     
      Interface INode256 Guid$("{96F79442-B3A1-48E2-B78C-7309BD6814B5}")
        Inherit IUnknown
        Property Get Item(hWnd As Dword) As IUnknown
          If hWnd>255 Then
            Property = Nothing
          Else
            Property = objs(hWnd)
          End If
        End Property
        Property Set Item(hWnd As Dword, value As IUnknown)
          If hWnd<256 Then objs(hWnd) = value
        End Property
      End Interface
    End Class
     
    Class MapHWndToObject Common
      Instance rootNode As INode256
      Instance indexes() As Long
      Class Method Create()
        rootNode = Class "Node256"
        ReDim indexes(4)
      End Method
        Class Method Destroy()
        ME.Clear()
        rootNode = Nothing
      End Method
     
      Interface IMapHWndToObject Guid$("{A9A0FCE8-3402-4F60-A46E-2C458869A064}")
        Inherit IUnknown
        Property Get Item(hWnd As Dword) As IUnknown
          Local node As INode256
          Property = Nothing
          node = ME.FindLeaf(hWnd, 0)
          If Not IsObject(node) Then Exit Property
          Property = node.Item(indexes(3))
        End Property
        Property Set Item(hWnd As Dword, value As IUnknown)
          Local node As INode256
          node = ME.FindLeaf(hWnd, -1)
          If Not IsObject(node) Then Exit Property
          node.Item(indexes(3)) = value
        End Property
        Method Remove(hWnd As Dword)
          Local node As INode256
          Local tmp As IUnknown
          node = ME.FindLeaf(hWnd, 0)
          If Not IsObject(node) Then Exit Method
          tmp = Nothing
          node.Item(indexes(3)) = tmp
        End Method
        Method Clear()
          ME.clear()
        End Method
      End Interface
      Class Method FindLeaf(hWnd As Dword, buildNode As Long) As INode256
        Local node As INode256
        Local tmpNode As INode256
        Register i As Long
        Dim v(4) As Byte At VarPtr(hWnd)
        Method = Nothing
        For i=0 To 3
          indexes(i) = CLng(v(i))
        Next
        node = rootNode
        For i=0 To 2
          tmpNode = node.Item(indexes(i))
          If Not IsObject(tmpNode) Then
            If Not buildNode Then Exit Method
            tmpNode = Class "Node256"
            If Not IsObject(tmpNode) Then
              Txt.Print "No node"
            End If
            node.Item(indexes(i)) = tmpNode
          End If
          node = tmpNode
        Next
        Method = node
      End Method
      Class Method Clear()
        Local a&, b&, c&, d&
        Local node1 As INode256
        Local node2 As INode256
        Local node3 As INode256
        Local tmp As IUnknown
        If Not IsObject(rootNode) Then Exit Method
        tmp = Nothing
        For a=0 To 255
          node1 = rootNode.Item(a)
          If IsObject(node1) Then
            For b=0 To 255
              node2 = node1.Item(b)
              If IsObject(node2) Then
                For c=0 To 255
                  node3 = node2.Item(c)
                  If IsObject(node3) Then
                    For d=0 To 255
                      node3.Item(d) = tmp
                    Next
                    node2.Item(c) = tmp
                  End If
                Next
                node1.Item(b) = tmp
              End If
            Next
            rootNode.Item(a) = tmp
          End If
        Next
      End Method
    End Class
     
    Function NewMapHWndToObject() Common As IMapHWndToObject
      Local obj As IMapHWndToObject
      obj = Class "MapHWndToObject"
      Function = obj
    End Function
    TestMap.bas - The test routines. Fully populates the map and then tests each item.

    Code:
    #Compile Exe
    #Dim All
    #Include "library.inc"
    #Link "map.sll"
     
    Function PBMain () As Long
      Dim i As Long
      Dim a As Long
      Dim v As ITest
      Dim n As IUnknown
      Dim m As ITest
      Dim hWnd As Long
      Txt.Window ("Test", 100,100) To hWnd
      Dim map As IMapHWndToObject
      map = NewMapHWndToObject()
      For i=1 To 300000
        v = NewTest(i)
        If IsObject(v) Then
          map.Item(i) = v
          n = map.Item(i)
          If IsObject(n) And IsInterface(n, ITest) Then
            m = n
            If m.Value <> v.Value Then
              a = m.Value
              Txt.Print Str$(i) & " got " & Str$(a)
            Else
              a = m.Value
            End If
          Else
            Txt.Print Str$(i) & " was not an object"
          End If
        End If
      Next
      Txt.Print "FInished"
      Txt.WaitKey$
    End Function
     
    Function NewTest(value As Long) As ITest
      Dim obj As ITest
      obj = Class "Test"
      obj.Value = value
      Function = obj
    End Function
     
    Class Test
      Instance mValue As Long
        Interface ITest Guid$("{24F55C2F-EDF7-4966-B98B-2473E7C44C85}")
          Inherit IUnknown
          Property Get Value() As Long
            Property = mValue
          End Property
          Property Set Value(value As Long)
            mValue = value
          End Property
      End Interface
    End Class
    Edited: Updated MapHWndToObject, DWORDS are 4 bytes... Also updated test to use different values
    Last edited by Larry Charlton; 16 Apr 2011, 07:13 PM. Reason: Flattened the sparse array, doubled the speed
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream
Working...
X