Linked List of Typed Pointers

[kevin]

Linked List of Typed Pointers

    This example demonstrates how to manually create a linked list of typed objects.    The code use inheritance to spawn the child type from the parent linked list.   Since you control the linking, you can link any child type descended from the linked list type safely into your list.    Moreover, if you modify the Link/unlink function you can control an infinite number (in  perfect world) of custom lists.

    Updated,

PlayBASIC Code: [Select]

Explicit on

   Type LinkList
         ForwardLink
         BackLink
         ObjectType
   EndType


   ; Point to the First object in use
   Global    FirstObject=0


Function LinkObject(Me as Linklist Pointer)
   dim NextObject as linklist pointer
   me.BackLink   =0
   if FirstObject<>0 
      NextObject            =FirstObject
      NextObject.backlink   =int(me)   
      
      ; link me to the old first object
      me.forwardlink         =FirstObject   
   endif 

   FirstObject=int(me)
EndFunction 





Function UnlinkObject(Me as LinkList pointer)
      dim PreviousObject as linklist pointer

      PreviousObject      =me.Backlink
      NextObject         =me.ForwardLink

      ; Check if were deleting the first object in the list
      if FirstObject=int(me) then    FirstObject=int(NextObject)      

         ; IF the next object isn't the end of the list, then set it's Back link to the previous object
      if int(NextObject)<>0       then NextObject.BackLink         =int(PreviousObject)
      if int(PreviousObject)<>0    then PreviousObject.ForwardLink   =int(NextObject)
EndFunction NextObject as linklist pointer



   ; declare the ball type from LinkList parent
   Type tBall as LinkList
         Name$
         x#,y#
         Radius
         COlour
         LifeTime
   EndType

   ; declare the Box type from LinkList parent
   Type tBox as LinkList
         Name$
         x1#,y1#,x2#,y2#
         COlour
         LifeTime
   EndType


   local ObjectCount

   Do
      Cls rgb(0,0,0)
         
         global CurrentTime=timer()
         
;         Print "First Object"+Str$(firstObject)
         Dim Obj as linkList pointer 
         Obj=FirstObject

         ; ============================
         ; Process Linked Object LIst
         ; ============================
         local ObjectsInList=0
         lockbuffer
            While int(Obj)
               local PreviousObject   =Obj.Backlink
               local NextObject      =obj.ForwardLink
         ;      print Str$(previousobject)+"<-"+Str$(int(Obj))+"->"+STR$(NextObject)
               Select obj.ObjectType
                     case tBall
                        obj=UpdateBall(Obj)

                     case tBox
                        obj=UpdateBox(Obj)
                                       
                     default   ; Unknown Object Type
                        Obj=Obj.Forwardlink            
               endselect
               inc ObjectsInList            
            EndWhile
         unlockbuffer


         Print "Object Count:"+str$(ObjectsInList)
         
         ; ====================================
         ; Select and Add Object to linked list
         ; =====================================

         if SpaceKey()=false
            Select Rnd(1)
               case 0
                  AddBall(ObjectCount)
               case 1
                  AddBox(ObjectCount)
            EndSelect
            inc ObjectCount
         endif   
         
      Sync   
   loop


Function AddBall(ObjectCount)
      Dim Obj as Tball pointer
      obj               = new tBall
      LinkObject(obj)
      obj.Objecttype      = tball
;      obj.name      ="Circle Object"+str$(ObjectCount)
      Obj.x         =rnd#(800)
      Obj.y         =rnd#(600)
      Obj.radius   =rndrange(10,20)
      Obj.Colour   =rndrgb()
      obj.LIfeTime=Timer()+2000
EndFunction


Function UpdateBall(Obj as tball pointer)
      local x#=Obj.x-1

      if   CurrentTime<obj.LIfeTime or (X#>-50)            
            local c=Obj.Colour
            local c1=rgbfade(c,25)
            Circlec x#,obj.y,obj.radius,true,c
            Circlec x#,obj.y,obj.radius,false,c1
            Obj.x=x#
            CenterText Obj.x,obj.y,obj.Name$
            NextObject=obj.forwardlink
      else
            NextObject=int(UnlinkObject(obj))

Login required to view complete source code

[kevin]

  Here's the same code as a native linked list type collection.

PlayBASIC Code: [Select]

   ; Enable Explicit Variable declaration
   Explicit on

   ; Parent Link list container
   Type ListObject
      ObjectType      
   EndType

   ; Dim the OBJ type for the hold this list within
   Dim Obj as ListObject List


   ; declare the ball type from LinkList parent
   Type tBall as ListObject
         Name$
         x#,y#
         Radius
         COlour
         LifeTime
   EndType

   ; declare the Box type from LinkList parent
   Type tBox as ListObject
         Name$
         x1#,y1#,x2#,y2#
         COlour
         LifeTime
   EndType


   local ObjectCount

   Do
      Cls rgb(0,0,0)
         
         global CurrentTime=timer()
         
         ; ============================
         ; Process Linked Object LIst
         ; ============================
         local ObjectsInList=0
         lockbuffer
            For each Obj()
               Select obj.ObjectType
                     case tBall
                        UpdateBall(Obj())

                     case tBox
                        UpdateBox(Obj())
                                       
                     default   ; Unknown Object Type
               endselect
               inc ObjectsInList            
            next
         unlockbuffer


         Print "Object Count:"+str$(ObjectsInList)
         
         ; ====================================
         ; Select and Add Object to linked list
         ; =====================================

         if SpaceKey()=false
            Select Rnd(1)
               case 0
                  AddBall(Obj(),ObjectCount)
               case 1
                  AddBox(obj(),ObjectCount)
            EndSelect
            inc ObjectCount
         endif   
         
      Sync   
   loop


Function AddBall(me.tBall,ObjectCount)
      me               = new tBall
      me.Objecttype      = tball

;      me.name      ="Circle Object"+str$(ObjectCount)
      me.x         =rnd#(800)
      me.y         =rnd#(600)
      me.radius   =rndrange(10,20)
      me.Colour   =rndrgb()
      me.LIfeTime=Timer()+2000
EndFunction


Function UpdateBall(me.tball)
      local x#=me.x-1

      if   CurrentTime<me.LIfeTime or (X#>-50)            
            local c=me.Colour
            local c1=rgbfade(c,25)
            Circlec x#,me.y,me.radius,true,c
            Circlec x#,me.y,me.radius,false,c1
            me.x=x#
;            CenterText me.x,me.y,me.Name$
      else
            ; Free This item from the list
            me =null
      endif

ENdFUnction





Function AddBox(me.tbox,ObjectCount)
      me = new tbox
      me.Objecttype      = tbox
      me.x1         =rnd#(800)
      me.y1         =rnd#(600)
      me.x2         =me.x1+rnd#(100)
      me.y2         =me.y1+rnd#(100)
      me.Colour   =rndrgb()
      me.LIfeTime=Timer()+rndrange(500,3000)
EndFunction
      

Function UpdateBox(me.tBox)
   if   CurrentTime<me.LIfeTime            
         local c=me.Colour
         local c1=rgbfade(c,25)
         local x=(me.x1+me.x2)/2
         local y=(me.y1+me.y2)/2
         ShadeBox me.x1,me.y1,me.x2,me.y2,c,c1,c,c1
         Boxc me.x1,me.y1,me.x2,me.y2,false,c1
   else
         ; Free This Item
         me = null                        
   endif
ENdFUnction

[kevin]

   Linked List With List Manager

      This version + demo is the same the first example, but this time it's set up to manage various linked lists through a simple interface.  So In this demo it runs four copies of the previous example, each in their own view port + list.

PlayBASIC Code: [Select]

   Explicit on


   Type ListManager
         First
   EndTYpe

   Dim ListTable(1) as ListManager


   Type LinkList
         ForwardLink
         BackLink
         ObjectType
   EndType


Function CreateList()
   index=GetFreeCEll(ListTable())   
   ListTable(Index).first=0
EndFunction Index


Function  GetFirstLInk(LIstHandle)
   if ListHandle>0 and LIstHandle<=GetArrayElements(ListTable(),1)
      Me=LIstTable(ListHandle).first
   endif
EndFunction Me as linkLIst pointer



Function LinkObject(ListHandle,Me as Linklist Pointer)
   dim NextObject as linklist pointer
   me.BackLink   =0
   
   if ListTable(ListHandle).first<>0 
      NextObject            =ListTable(ListHandle).first
      NextObject.backlink   =int(me)   
   endif 

   ; link me to the old first object
   me.forwardlink         =ListTable(ListHandle).First   

   ListTable(ListHandle).first=int(me)
EndFunction 




Function UnlinkObject(ListHandle,Me as LinkList pointer)
      dim PreviousObject as linklist pointer

      PreviousObject      =me.Backlink
      NextObject         =me.ForwardLink

      ; Check if were deleting the first object in the list
      if ListTable(ListHandle).First=int(me) then    ListTable(ListHandle).First=int(NextObject)      

         ; IF the next object isn't the end of the list, if not then set it's Back link to the previous object
      if int(NextObject)<>0       then NextObject.BackLink         =int(PreviousObject)
      if int(PreviousObject)<>0    then PreviousObject.ForwardLink   =int(NextObject)

      Me.Backlink=-1
      Me.Forwardlink=-1

EndFunction NextObject as linklist pointer



   ; declare the ball type from LinkList parent
   Type tBall as LinkList
         Name$
         x,y
         Radius
         COlour
         LifeTime
   EndType

   ; declare the Box type from LinkList parent
   Type tBox as LinkList
         Name$
         x1,y1,x2,y2
         COlour
         LifeTime
   EndType




   
   ; CReate a Handle for this 
   global MyLinkList=0
   


   Type tRect
      x1,y1,x2,y2
   Endtype

   Type tGame
      ListHandle
      CameraHandle
      Viewport as tRect
      ObjectCount
      BackDropColour
   EndType


   Dim Game as tGame list

; Create Game PLayer #1   
   Game = new tGame
   Game.ListHandle=CreateList()
   Game.BackDropColour = Rndrgb()
   Game.Viewport.x1=0   
   Game.Viewport.y1=0   
   Game.Viewport.x2=GetSurfacewidth()/2   
   Game.Viewport.y2=GetSurfaceHeight()/2   


; Create Game Player #2 (right hand side of display)

   Game = new tGame
   Game.ListHandle=CreateList()
   Game.BackDropColour = Rndrgb()
   Game.Viewport.x1=GetSurfacewidth()/2   
   Game.Viewport.y1=0   
   Game.Viewport.x2=GetSurfacewidth()   
   Game.Viewport.y2=GetSurfaceHeight()/2   



; Create Game PLayer #3   
   Game = new tGame
   Game.ListHandle=CreateList()
   Game.BackDropColour = Rndrgb()
   Game.Viewport.x1=0   
   Game.Viewport.y1=GetSurfaceHeight()/2   
   Game.Viewport.x2=GetSurfacewidth()/2   
   Game.Viewport.y2=GetSurfaceHeight()   


; Create Game Player #4 (right hand side of display)

   Game = new tGame
   Game.ListHandle=CreateList()
   Game.BackDropColour = Rndrgb()
   Game.Viewport.x1=GetSurfacewidth()/2   
   Game.Viewport.y1=GetSurfaceHeight()/2   

Login required to view complete source code