Help on Array delition hanging

[Andreas]

 This crashes after 4-5 sec.. ??? In PBFX 1.74 I have no idea.

Code Select Expand


; PROJECT : Main
; AUTHOR  : Andy
; CREATED : 01.05.2008
; EDITED  : 31.01.2009
; ---------------------------------------------------------------------

;setfps 60

;screenvsync on


global SPCount


openscreen 1280,800,32,2
load3dimage "ship.bmp",1


type tParticle

x#,y#

xSpeed#,ySpeed#
angle#
rotSpeed#

lifespan

sprite
image

endtype
dim part as tParticle list



ScreenVsync on
w=getscreenwidth()
h=getscreenheight()


xBase=w/2
yBase=500
dis=30

text 100,500, "PRESS THE ANY KEY"

sync
waitkey
rem ---------------------------------------
rem                 MAIN LOOP
rem----------------------------------------

repeat

cls 0


mx=mousex()
my=mousey()

;print getangle2d(xBase,yBase,mx,my)
ma=getangle2d(xBase,yBase,mx,my)

if mousebutton()
createPart(xBase,yBase,ma,rnd(3.0)+1,1.0,3000,1)
endif

for lp=0 to dis
dot xBase+cos(ma)*lp,yBase+sin(ma)*lp
next



updatePart()
drawallsprites



print "Sprites"+str$(SPCount)
print "FPS: "+str$(fps())

sync



until esckey()
end



function createPart(x#,y#,angle#,speed#,rotSpeed#,lifeSpan,image)

part= new tParticle

part.x# =x#
part.y# =y#

part.xspeed# =cos(angle#)*speed#
part.yspeed# =sin(angle#)*speed#

part.angle# =0

part.lifespan =timer()+lifeSpan
part.image =image

part.sprite =newsprite(part.x#,part.y#,1)

part.rotSpeed# =rotSpeed#

;CenterSpriteHandle part.sprite
;SpriteRotationMode part.sprite,0
spritedrawmode part.sprite,2

;spritecollisionmode part.sprite,1
;spritecollisionworld part.sprite,1

inc SPCount

endfunction
Function updatePart()


currentTime=timer()

rem --ONE FOR ALL--
for each Part()

; --- Death Checks


if part.lifespan=<currentTime
deletesprite part.sprite
part = null
dec SPCount
continue
endif


movesprite part.sprite,part.xspeed#,part.yspeed#
turnsprite part.sprite,part.rotSpeed#

next

endfunction


[kevin]

 it seems to be the list deletion that's causing the hang.  For the time being you could use a typed array, or a roll your own typed pointer linked list.   


BTW.  Please try can make the thread title helpful to others.   

[Andreas]

Aah ok thanks. Arrays.. Need to get the grips with it.

Andreas

[Andreas]

Got it working with dimensioned arrays. But what I realy want to do is this!  ;D

Code Select Expand

; 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



Any way we can get this working 1.74? So I can dissect and experiment. It would be _very_ helpfull to me.

Andreas

[kevin]

erm,  might I ask how you're going to delete them ?    I suggest, Use the list manger for now.