Note: This Code requires PlayBASIC V1.10 (or newer) to run correctly, will most likely crash in older versions.
Linked List Module
[pbcode]
; ==============================================================
; Define the 'Parent' Link List elements
; ==============================================================
Type tList
NextLink
PreviousLink
FirstUsed; only seeded in element zero
FirstFree; only seeded in element zero
EndType
;
; Dim List(0) as tList
; *=--------------------------------------------------------------=*
; >> Init linked List <<
; *=--------------------------------------------------------------=*
; Element zero is used to house the list properties (first/free)
; all other elements are linked forward andback. upon creation
; elemented 1 through to the Maxsize will be linked as FREE
; *=--------------------------------------------------------------=*
Psub InitList(Me().tlist,MaxSize)
Dim me(MaxSize) as tlist
me(0).FirstUsed=0
me(0).FirstFree=1
For lp=1 to MaxSize
me(lp).PreviousLink =lp-1
me(lp).NextLink =LP+1
next
; set the Next link in the last item to null
me(lp).NextLink =0
EndPsub
; *=--------------------------------------------------------------=*
; >> Show List<<
; *=--------------------------------------------------------------=*
; this is just debug function which shows the linking of each element
; *=--------------------------------------------------------------=*
Psub ShowList(Me().tlist,Size)
print "First USED:"+str$( me(0).FirstUsed)
print "First FREE:"+str$(me(0).FirstFree)
For lp=1 to Size
print "item"+str$(lp)+" Prev"+str$(me(lp).PreviousLink)+" , Next"+ str$(me(lp).NextLink)
next
ThisItem=me(0).FirstFree
s$=""
While ThisItem>0
s$=s$+Str$(Thisitem)+","
ThisItem=me(ThisItem).NextLink
endwhile
print "Free List:"+s$
EndPsub
; *=--------------------------------------------------------------=*
; >> Get The First Element the List <<
; *=--------------------------------------------------------------=*
Psub GetFirst(me().tlist)
; Get the current first item
ThisLink=me(0).FirstUsed
EndPsub ThisLink
; *=--------------------------------------------------------------=*
; >> Get a NEW Link <<
; *=--------------------------------------------------------------=*
; This functions grabs a free element from the free list.
; *=--------------------------------------------------------------=*
Function NewLink(me().tlist)
FirstFreeLink =me(0).FirstFree
; ===========================
; Check if link is full
; ===========================
if FirstFreeLink<>0
; unlink the free item from the free list
; PreviousFreeLink =me(FirstFreeLink).PreviousLInk
NextFreeLink =me(FirstFreeLink).NextLInk
me(NextFreeLink).PreviousLInk =0
; Get the current first item
FirstUsedLink =me(0).FirstUsed
; if not first the set the old first link to point back at the new one
if FirstUsedLink<>0
; adjust Back link of the old first item
me(FirstUsedlink).PreviousLink=FirstFreeLInk
endif
; init the new cells previous and next links
me(FirstFreeLink).previouslink =0
me(Firstfreelink).nextlink =FirstUsedLink
me(0).FirstFree =NextFreeLink
me(0).FirstUsed =FirstFreeLink
; Bump the
endif
EndFunction FirstFreeLInk
; *=--------------------------------------------------------------=*
; >> Delete Link <<
; *=--------------------------------------------------------------=*
; This function deletes a link and returns it tot eh free list.
; *=--------------------------------------------------------------=*
Psub DeleteLink(me().tlist,ThisItem)
FirstFreeLink =me(0).FirstFree
FirstUsedLink =me(0).FirstUsed
; Get the pervous and next links from this item
PreviousItemLink =Me(ThisItem).PreviousLInk
NextItemLink =Me(ThisItem).NextLInk
; Check if the frist link is being deleted
if FirstUsedLink=ThisItem then me(0).FirstUsed=NextItemLink
; Link Previous item forward to then Next item
If PreviousItemLink<>0 then Me(PreviousItemLink).NextLink=NextItemLink
; Link Next item back to the Previous item
If NextItemLink<>0 then Me(NextItemLink).PreviousLink=PreviousItemLink
; Add newly unliked item to the head of the FREE list
Me(ThisItem).NextLink=0
Me(ThisItem).NextLink=FirstFreeLink
; Link the Head of the free list back to the next item
if FirstFreeLInk<>0 then me(FirstFreeLInk).PreviousLink=ThisItem
me(0).FirstFree=ThisItem
EndPsub
[/code]
and here's some demo code that uses the above module.
[code]
; Create the Alien type, which inturn inherits the Linked list fields
; from tList. Now Since it's child tList, it can passed into and maniplated
; via the linked list functions.
Type tAlien as tList
Status
SpeedX#
SpeedY#
Score
Sprite
LifeTimer
endtype
; define the Aliens() type array
Dim Aliens(0)as talien
; Variable to holds the size of a list
listsize=20
; Init the aliens as linekd list
InitLIst(aliens().tAlien,ListSize)
; create a camera (whih will default to being the screen size
CreateCamera 1
Do
cls rgb(40,60,40)
; Update the ALiens (well balls)
aliens=ProcessAliens()
; Dispaly the active number of aliens
print "Alien Count:"+digits$(aliens,4)
; Hold ENTER down to show list links
if Enterkey()
ShowList(Aliens().talien,ListSize)
endif
; Press Space to Add an alien
if SpaceKey() and keypressed=false
sw=getscreenwidth()
sh=getscreenHeight()
Newalien(rndrange(100,sw-100),rndrange(100,sh-100))
keypressed=true
endif
; Wait unntil nno keys are pressed before reseting the keypressed state
if scancode()=0 then KeyPressed=false
; draw all sprites
DrawAllsprites
; Show the user the display
Sync
; Loop back to the DO and continue
loop
;*=-------------------------------------------------------------=*
; Process Aliens
;*=-------------------------------------------------------------=*
; this function runs through the alien list updating their positions
; If an alien moves off the sreen or is alive longer than 5 seconds
; it gets deleted
;*=-------------------------------------------------------------=*
Function ProcessAliens()
ThisAlien=GetFirst(Aliens().talien)
While ThisAlien<>0
inc aliens
SpriteIndex=Aliens(ThisAlien).sprite
MoveSprite SpriteIndex,Aliens(Thisalien).speedX#,Aliens(Thisalien).speedY#
if SpriteInCamera(SpriteIndex,1)=false or Timer()>Aliens(ThisAlien).lifetimer
ThisALien=DeleteAlien(ThisAlien)
Continue
endif
; get the next one
ThisAlien=Aliens(ThisAlien).NextLInk
endwhile
EndFunction aliens
;*=-------------------------------------------------------------=*
; New Alien
;*=-------------------------------------------------------------=*
Function NewAlien(xpos,ypos)
index=NewLink(Aliens().tAlien)
if Index
Aliens(index).Status=true
; CReate a new sprite + new image for it
Aliens(index).sprite=NewSprite(Xpos,ypos,NewBallImage(rndrange(10,30),rndrgb()))
angle#=rnd(360)
Speed#=rndrange(1,5)
Aliens(index).SpeedX#=cos(angle#)*speed#
Aliens(index).SpeedY#=sin(angle#)*speed#
Aliens(index).lifetimer=timer()+5000
endif
EndFunction Index
;*=-------------------------------------------------------------=*
; Delete Alien
;*=-------------------------------------------------------------=*
Function DeleteAlien(ThisAlien)
if Aliens(ThisAlien).status=true
; get the next alien in the list
NextAlien=aliens(Thisimage).nextlink
; delete the sprite and it's referenced image
ThisSprite=Aliens(ThisAlien).Sprite
deleteimage getspriteimage(thissprite)
deletesprite ThisSprite
; turn this aliens status off
Aliens(ThisAlien).status=false
; unlink this item from the list to delete it
DeleteLink(Aliens().talien,ThisAlien)
endif
EndFunction Nextalien
;*=-------------------------------------------------------------=*
; New Ball IMage
;*=-------------------------------------------------------------=*
; Creates a coloured ball (looking image)
Function NewBallImage(size,col)
OldSurface=getSurface()
ThisImage=Newimage(Size,Size)
rendertoimage ThisImage
RenderPhongImage ThisImage,Size/2,Size/2,col,255,260/(size/2)
rendertoImage OldSurface
EndFunction ThisIMage
[/pbcode]