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,
[pbcode]
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))
free Obj
endif
ENdFUnction NextObject as LinkList Pointer
Function AddBox(ObjectCount)
Dim Obj as tBox pointer
obj = new tbox
LinkObject(obj)
obj.Objecttype = tbox
Obj.x1 =rnd#(800)
Obj.y1 =rnd#(600)
Obj.x2 =Obj.x1+rnd#(100)
Obj.y2 =Obj.y1+rnd#(100)
Obj.Colour =rndrgb()
obj.LIfeTime=Timer()+rndrange(500,3000)
EndFunction
Function UpdateBox(Obj as tBox pointer)
if CurrentTime<obj.LIfeTime
local c=Obj.Colour
local c1=rgbfade(c,25)
local x=(Obj.x1+Obj.x2)/2
local y=(Obj.y1+Obj.y2)/2
ShadeBox Obj.x1,obj.y1,Obj.x2,obj.y2,c,c1,c,c1
Boxc Obj.x1,obj.y1,Obj.x2,obj.y2,false,c1
; CenterText x,y,obj.Name$
NextObject=obj.forwardlink
else
NextObject=int(UnlinkObject(obj))
free Obj
endif
ENdFUnction NextObject as LinkList Pointer
[/pbcode]
Here's the same code as a native linked list type collection.
[pbcode]
; 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
[/pbcode]
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.
[pbcode]
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
Game.Viewport.x2=GetSurfacewidth()
Game.Viewport.y2=GetSurfaceHeight()
local ObjectCount
Do
global CurrentTime=timer()
For Each Game()
Dim Obj as linkList pointer
MyLinkList=Game.ListHandle
Obj=GetFirstLInk(Game.ListHandle)
ScreenViewport Game.Viewport.x1,Game.Viewport.y1,Game.Viewport.x2,Game.Viewport.y2
Cls Game.BackDropColour
; ====================================
; Select and Add Object to linked list
; =====================================
if SpaceKey()=false
if rnd(1000)>900
Select Rnd(1)
case 0
AddBall(MyLinkList)
case 1
AddBox(MyLinkList)
EndSelect
inc ObjectCount
endif
endif
; ============================
; Process Linked Object LIst
; ============================
local ObjectsInList=0
lockbuffer
While int(Obj)<>0
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
Text game.Viewport.X1,game.Viewport.Y1,"Object Count:"+str$(ObjectsInList)
Game.ObjectCount=ObjectsInList
next
ScreenViewport 0,0,getsurfacewidth(),getsurfaceheight()
Sync
loop
Function AddBall(ListHandle)
Dim Obj as Tball pointer
obj = new tBall
LinkObject(ListHandle,obj)
obj.Objecttype = tball
obj.name ="Circle"+str$(ListHandle)
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) and (X>(Game.Viewport.X1-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(MyLinkList,obj))
free Obj
endif
EndFunction NextObject as LinkList Pointer
Function AddBox(Listhandle)
Dim Obj as tBox pointer
obj = new tbox
LinkObject(MyLinkList,obj)
obj.Objecttype = tbox
Obj.name$ ="Box"+STR$(Listhandle)
Obj.x1 =rnd(800)
Obj.y1 =rnd(600)
Obj.x2 =Obj.x1+rnd(100)
Obj.y2 =Obj.y1+rnd(100)
Obj.Colour =rndrgb()
obj.LIfeTime=Timer()+rndrange(500,3000)
EndFunction
Function UpdateBox(Obj as tBox pointer)
if CurrentTime<obj.LIfeTime
local c=Obj.Colour
local c1=rgbfade(c,25)
local x=(Obj.x1+Obj.x2)/2
local y=(Obj.y1+Obj.y2)/2
ShadeBox Obj.x1,obj.y1,Obj.x2,obj.y2,c,c1,c,c1
Boxc Obj.x1,obj.y1,Obj.x2,obj.y2,false,c1
obj.colour=obj.colour+1
CenterText x,y,obj.Name$
NextObject=obj.forwardlink
else
NextObject=int(UnlinkObject(MyLinkList,obj))
free Obj
endif
ENdFUnction NextObject as LinkList Pointer
[/pbcode]