Bouncing Balls :)
Posted: Sun May 17, 2009 10:42 pm
I hope people find this interesting/useful. The collision response algorithm was adapted from one in the book "Essential Mathematics for Games and Interactive Applications".
The code is written to (hopefully) be scaleable - collision checks are only done over the ball's local area and no collision pair should be tested more than once. This means you should be able to increase the map size quite a lot with not too much of a performance hit (famous last words!)
If you want to simulate a 'wrap-around' universe where objects disappear off the right and reappear on the left you only have to comment/uncomment a couple of blocks, I've shown where in the code.
To change how much momentum a ball loses in a collision just pass a different 'e' value to CreateBall().
The code is written to (hopefully) be scaleable - collision checks are only done over the ball's local area and no collision pair should be tested more than once. This means you should be able to increase the map size quite a lot with not too much of a performance hit (famous last words!)
If you want to simulate a 'wrap-around' universe where objects disappear off the right and reappear on the left you only have to comment/uncomment a couple of blocks, I've shown where in the code.
To change how much momentum a ball loses in a collision just pass a different 'e' value to CreateBall().
Code: Select all
EnableExplicit
Structure LLElement
*Next.LLElement
*Previous.LLElement
*List.LLElementList
EndStructure
Structure LLElementList
*First.LLElement
*Last.LLElement
Size.l
EndStructure
Structure Entity Extends LLElement
Type.l
PositionX.f
PositionY.f
*CollisionTestRecordList.LLElementList
EndStructure
Structure Ball Extends Entity
ID.l
Radius.f
Mass.f
VelocityX.f
VelocityY.f
e.d
EndStructure
Structure Sector
*Occupants.LLElementList
EndStructure
Structure Timer
Freq.l
Ticks.l
EndStructure
Structure CollisionTestRecord Extends LLElement
*Entity.Entity
EndStructure
Declare.l HandleInput()
Declare.l DrawGrid()
Declare.l CreateBall(x.l,y.l,Radius.l,e.d)
Declare.l UpdateBall(*b.Ball)
Declare.l DrawBall(*b.Ball)
Declare.l UpdateEntities()
Declare.l DrawEntities()
Declare.l CreateCollisionTestRecord(*e1.Entity,*e2.Entity)
Declare.l DestroyCollisionTestRecords(*e.Entity)
Declare.l CollisionTestDone(*e1.Entity,*e2.Entity)
Declare.l DoCollisions()
Declare.l CirclesCollide(x1.f,y1.f,Radius1.f,x2.f,y2.f,Radius2.f)
Declare.l IndexNeighbours(*e.Entity,Range)
Declare.l CreateTimer(Freq)
Declare.l WaitTimer(*Timer.Timer)
Declare.f Dot(x1.f,y1.f,x2.f,y2.f)
Declare.f FMod(a.f,b.f)
Declare.l LLRemoveElement(*Element.LLElement)
Declare.l LLAddElement(*Element.LLElement,*List.LLElementList)
Declare.l LLInsertElementAfter(*Element1.LLElement,*Element2.LLElement)
Declare.l LLInsertElementBefore(*Element1.LLElement,*Element2.LLElement)
Declare.l LLDestroyElementList(*ElementList.LLElementList)
Declare.l LLDestroyElement(*Element.LLElement)
Declare.l LLCreateElement(Size.l)
Declare.l LLCreateElementList()
Global DRAW_GRID = 1
#FPS = 30
#SCREEN_WIDTH = 512
#SCREEN_HEIGHT = 512
#SCREEN_DEPTH = 32
#SECTOR_SIZE = 64
#MAP_WIDTH_SECTORS = 8
#MAP_HEIGHT_SECTORS = 8
#MAP_WIDTH_PIXELS = #SECTOR_SIZE * #MAP_WIDTH_SECTORS
#MAP_HEIGHT_PIXELS = #SECTOR_SIZE * #MAP_HEIGHT_SECTORS
#SCREEN_WIDTH_SECTORS = #SCREEN_WIDTH / #SECTOR_SIZE
#SCREEN_HEIGHT_SECTORS = #SCREEN_HEIGHT / #SECTOR_SIZE
Global Dim MAP.Sector(#MAP_WIDTH_SECTORS - 1,#MAP_HEIGHT_SECTORS - 1)
Define x,y
For y = 0 To #MAP_HEIGHT_SECTORS - 1
For x = 0 To #MAP_WIDTH_SECTORS - 1
MAP(x,y)\Occupants = LLCreateElementList()
Next
Next
Global MAP_ORIGIN_X = 0
Global MAP_ORIGIN_Y = 0
#SCROLL_STEP = 8
; entity constants
Enumeration 1
#ET_BALL
EndEnumeration
; entity neighbours array for fast access to entities
; near a particular sector
Global Dim *NEIGHBOURS.Entity(0)
; ball globals
Global BALL_MAX_SPEED.f = 8
Global BALL_MAX_RADIUS = 32
Global BALL_DRAW_ID_NUMBERS = 0
Global BALL_NEXT_ID = 1
RandomSeed(ElapsedMilliseconds())
Define i.l
Define *Timer = CreateTimer(1000 / #FPS)
Define Window.l = OpenWindow(1,0,0,#SCREEN_WIDTH,#SCREEN_HEIGHT,"Bouncing Balls")
Define Pings.l
Define EventID.l
If Not IsWindow(1)
MessageRequester("OOPS!","Sorry, could not open window.")
End
EndIf
If Not InitSprite()
MessageRequester("OOPS!","Sorry, could not initialise graphics environment.")
End
EndIf
If Not OpenWindowedScreen(WindowID(1),0,0,#SCREEN_WIDTH,#SCREEN_HEIGHT,0,0,0)
MessageRequester("OOPS!","Sorry, could not set graphics mode.")
End
EndIf
If Not InitKeyboard()
CloseScreen()
MessageRequester("OOPS!","Sorry, could not initialise keyboard.")
End
EndIf
RandomSeed(ElapsedMilliseconds())
For i = 0 To 7
CreateBall(Random(#MAP_WIDTH_PIXELS-1),Random(#MAP_HEIGHT_PIXELS-1),8 + Random(BALL_MAX_RADIUS - 8),0.98)
Next
;- Main
Repeat
Pings = WaitTimer(*Timer)
For i = 1 To Pings
DoCollisions()
UpdateEntities()
HandleInput()
Next
EventID.l = WindowEvent();WaitWindowEvent(2)
Select EventID
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
EndSelect
ClearScreen(RGB(0,0,0))
If StartDrawing(ScreenOutput())
DrawingMode(#PB_2DDrawing_Transparent)
DrawGrid()
DrawEntities()
StopDrawing()
FlipBuffers()
EndIf
ForEver
End
Procedure.l HandleInput()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
End
EndIf
If KeyboardPushed(#PB_Key_Up)
If MAP_ORIGIN_Y > 0
MAP_ORIGIN_Y - #SCROLL_STEP
EndIf
If MAP_ORIGIN_Y < 0
MAP_ORIGIN_Y = 0
EndIf
EndIf
If KeyboardPushed(#PB_Key_Down)
If MAP_ORIGIN_Y < #MAP_HEIGHT_PIXELS - #SCREEN_HEIGHT
MAP_ORIGIN_Y + #SCROLL_STEP
EndIf
If MAP_ORIGIN_Y > #MAP_HEIGHT_PIXELS - #SCREEN_HEIGHT
MAP_ORIGIN_Y = #MAP_HEIGHT_PIXELS - #SCREEN_HEIGHT
If MAP_ORIGIN_Y < 0
MAP_ORIGIN_Y = 0
EndIf
EndIf
EndIf
If KeyboardPushed(#PB_Key_Left)
If MAP_ORIGIN_X > 0
MAP_ORIGIN_X - #SCROLL_STEP
EndIf
If MAP_ORIGIN_X < 0
MAP_ORIGIN_X = 0
EndIf
EndIf
If KeyboardPushed(#PB_Key_Right)
If MAP_ORIGIN_X < #MAP_WIDTH_PIXELS - #SCREEN_WIDTH
MAP_ORIGIN_X + #SCROLL_STEP
EndIf
If MAP_ORIGIN_X > #MAP_WIDTH_PIXELS - #SCREEN_WIDTH
MAP_ORIGIN_X = #MAP_WIDTH_PIXELS - #SCREEN_WIDTH
If MAP_ORIGIN_X < 0
MAP_ORIGIN_X = 0
EndIf
EndIf
EndIf
EndProcedure
Procedure.l DrawGrid()
If DRAW_GRID = 0
ProcedureReturn
EndIf
Protected ox = -(MAP_ORIGIN_X % #SECTOR_SIZE)
Protected oy = -(MAP_ORIGIN_Y % #SECTOR_SIZE)
; calculate number of visible sectors
Protected vsx = #SCREEN_WIDTH / #SECTOR_SIZE
Protected vsy = #SCREEN_HEIGHT / #SECTOR_SIZE
Protected x,y
If ox <> 0
vsx + 1
EndIf
If #SCREEN_WIDTH % #SECTOR_SIZE
vsx + 1
EndIf
If oy <> 0
vsy + 1
EndIf
If #SCREEN_HEIGHT % #SECTOR_SIZE
vsy + 1
EndIf
If vsx > #MAP_WIDTH_SECTORS
vsx = #MAP_WIDTH_SECTORS
EndIf
If vsy > #MAP_HEIGHT_SECTORS
vsy = #MAP_HEIGHT_SECTORS
EndIf
For y = 0 To vsy
Box(ox,oy+y*#SECTOR_SIZE,vsx*#SECTOR_SIZE,1,RGB(0,0,255))
Next
For x = 0 To vsx
Box(ox+x*#SECTOR_SIZE,oy,1,vsy*#SECTOR_SIZE,RGB(0,0,255))
Next
EndProcedure
Procedure.l CreateBall(x.l,y.l,Radius.l,e.d)
Protected *b.Ball = LLCreateElement(SizeOf(Ball))
Protected v.f,a.f
Protected XSector.l,YSector.l
If *b
*b\Type = #ET_BALL
*b\PositionX = x
*b\PositionY = y
*b\Radius = Radius
*b\Mass = Radius * Radius * #PI; / 100.0
*b\e = e
*b\ID = BALL_NEXT_ID
XSector = x / #SECTOR_SIZE
YSector = y / #SECTOR_SIZE
a = Random(2 * #PI * 100) / 100.0
*b\VelocityX = BALL_MAX_SPEED * Cos(a)
*b\VelocityY = BALL_MAX_SPEED * Sin(a)
;*b\VelocityX = *b\VelocityX / (Random(5) + 1)
;*b\VelocityY = *b\VelocityY / (Random(5) + 1)
LLAddElement(*b,MAP(XSector,YSector)\Occupants)
*b\CollisionTestRecordList = LLCreateElementList()
BALL_NEXT_ID + 1
EndIf
ProcedureReturn *b
EndProcedure
Procedure.l UpdateBall(*b.Ball)
Protected XSector1.l,YSector1.l
Protected XSector2.l,YSector2.l
Protected bx,by
; If Sqr(*b\VelocityX * *b\VelocityX + *b\VelocityY * *b\VelocityY) > BALL_MAX_SPEED
; *b\VelocityX = BALL_MAX_SPEED * Cos(atan2(*b\VelocityY,*b\VelocityX))
; *b\VelocityY = BALL_MAX_SPEED * Sin(atan2(*b\VelocityY,*b\VelocityX))
; EndIf
;Debug "position"
;Debug *b\PositionX
;Debug *b\PositionY
;Debug "vx = " + StrF(*b\VelocityX) + ", vy = " + StrF(*b\VelocityY)
*b\PositionX = *b\PositionX + *b\VelocityX
*b\PositionY = *b\PositionY + *b\VelocityY
; calculate new sector of ball
bx = Round(*b\PositionX,#PB_Round_Down)
by = Round(*b\PositionY,#PB_Round_Down)
XSector2 = Round(bx / #SECTOR_SIZE,#PB_Round_Down)
YSector2 = Round(by / #SECTOR_SIZE,#PB_Round_Down)
; for a wraparound (re-entrant) universe, uncomment the next
; two If statements and comment out the edge collision code
; in the DoCollisions procedure
; wrap
; If *b\PositionX >= #SECTOR_SIZE * #MAP_WIDTH_SECTORS
; *b\PositionX = FMod(*b\PositionX,#SECTOR_SIZE * #MAP_WIDTH_SECTORS)
; ElseIf *b\PositionX < 0.0
; *b\PositionX = #SECTOR_SIZE * #MAP_WIDTH_SECTORS + *b\PositionX
; EndIf
;
; If *b\PositionY >= #SECTOR_SIZE * #MAP_HEIGHT_SECTORS
; *b\PositionY = FMod(*b\PositionY,#SECTOR_SIZE * #MAP_HEIGHT_SECTORS)
; ElseIf *b\PositionY < 0.0
; *b\PositionY = #SECTOR_SIZE * #MAP_HEIGHT_SECTORS + *b\PositionY
; EndIf
; if new sector is different from old, wrap sector if
; necessary, then remove object from the first sector's
; linked list and add it to the second
If XSector2 <> XSector1 Or YSector2 <> YSector1
If XSector2 < 0
;Debug "xs2"
;Debug XSector2
XSector2 = #MAP_WIDTH_SECTORS + XSector2
ElseIf XSector2 > (#MAP_WIDTH_SECTORS - 1)
XSector2 % (#MAP_WIDTH_SECTORS) ; - 1)
EndIf
If YSector2 < 0
YSector2 = #MAP_HEIGHT_SECTORS + YSector2
ElseIf YSector2 > (#MAP_HEIGHT_SECTORS - 1)
YSector2 % (#MAP_HEIGHT_SECTORS) ; - 1)
EndIf
If (XSector2 > #MAP_WIDTH_SECTORS - 1) Or (XSector2 < 0) Or (YSector2 > #MAP_HEIGHT_SECTORS - 1) Or (YSector2 < 0)
Debug "sectors"
Debug XSector2
Debug YSector2
End
EndIf
LLAddElement(*b,MAP(XSector2,YSector2)\Occupants)
EndIf
EndProcedure
Procedure.l DrawBall(*b.Ball)
Protected TW.l,TH.l
Protected ID$
If *b
; draw ball
Circle(*b\PositionX - MAP_ORIGIN_X,*b\PositionY - MAP_ORIGIN_Y,*b\Radius,RGB(0,255,0))
ID$ = Str(*b\ID)
TW = TextWidth(ID$)
TH = TextHeight(ID$)
If BALL_DRAW_ID_NUMBERS
; draw ID number
DrawText(*b\PositionX - 0.5 * TW - MAP_ORIGIN_X,*b\PositionY - 0.5 * TH - MAP_ORIGIN_Y,ID$,RGB(255,255,255),RGB(255,0,0))
EndIf
EndIf
EndProcedure
Procedure.l UpdateEntities()
Protected x.l,y.l
Protected *e.Entity
For y = 0 To #MAP_HEIGHT_SECTORS - 1
For x = 0 To #MAP_WIDTH_SECTORS - 1
;Debug "looping thru occupants"
*e = MAP(x,y)\Occupants\First
While *e <> 0
Select *e\Type
Case #ET_BALL
UpdateBall(*e)
EndSelect
*e = *e\Next
Wend
Next
Next
EndProcedure
Procedure.l DrawEntities()
Protected x.l,y.l
Protected *e.Entity
For y = 0 To #MAP_HEIGHT_SECTORS - 1
For x = 0 To #MAP_WIDTH_SECTORS - 1
*e = MAP(x,y)\Occupants\First
While *e <> 0
Select *e\Type
Case #ET_BALL
DrawBall(*e)
EndSelect
*e = *e\Next
Wend
Next
Next
EndProcedure
Procedure.l CreateCollisionTestRecord(*e1.Entity,*e2.Entity)
Protected *CollisionTestRecord.CollisionTestRecord
*CollisionTestRecord = LLCreateElement(SizeOf(CollisionTestRecord))
*CollisionTestRecord\Entity = *e2
LLAddElement(*CollisionTestRecord,*e1\CollisionTestRecordList)
ProcedureReturn 1
EndProcedure
Procedure.l DestroyCollisionTestRecords(*e.Entity)
Protected *i1.CollisionTestRecord
Protected *i2.CollisionTestRecord
*i1 = *e\CollisionTestRecordList\First
While *i1
*i2 = *i1\Next
LLDestroyElement(*i1)
*i1 = *i2
Wend
EndProcedure
Procedure.l CollisionTestDone(*e1.Entity,*e2.Entity)
Protected *i1.CollisionTestRecord, *i2.CollisionTestRecord
*i1 = *e1\CollisionTestRecordList\First
While *i1
If *i1\Entity = *e2
ProcedureReturn 1
EndIf
*i1 = *i1\Next
Wend
*i2 = *e2\CollisionTestRecordList\First
While *i2
If *i2\Entity = *e1
ProcedureReturn 1
EndIf
*i2 = *i2\Next
Wend
ProcedureReturn 0
EndProcedure
Procedure.l DoCollisions()
Protected NeighbourCount.l
Protected i.l
Protected x.l,y.l
Protected *e1.Entity
Protected *e2.Entity
Protected *b.Ball
Protected *b1.Ball
Protected *b2.Ball
Protected Angle.f
Protected NormalX.f
Protected NormalY.f
Protected NormalLength.f
Protected RelativeVelocityX.f
Protected RelativeVelocityY.f
Protected VelocityDotNormal.f
Protected ModifiedVelocity,f
Protected j1.f
Protected j2.f
Protected CollisionPointX.f
Protected CollisionPointY.f
Protected Distance.f
Protected Penetration.f
;Debug ""
;Debug "Doing Collisions"
;Debug ""
For y = 0 To #MAP_HEIGHT_SECTORS - 1
For x = 0 To #MAP_WIDTH_SECTORS - 1
*e1 = MAP(x,y)\Occupants\First
While *e1
NeighbourCount = IndexNeighbours(*e1,(2 * BALL_MAX_RADIUS) / #SECTOR_SIZE)
;Debug "neighbour count = " + Str(NeighbourCount)
; for a wraparound (re-entrant) universe comment out the next If block
; and uncomment the 'wrap' code in the UpdateBall procedure
If *e1\Type = #ET_BALL
; handle collisions with edges of screen
*b = *e1
If *b\PositionX - *b\Radius <= 0
*b\PositionX = *b\Radius
*b\VelocityX = -(*b\VelocityX * *b\e)
EndIf
If *b\PositionY - *b\Radius <= 0
*b\PositionY = *b\Radius
*b\VelocityY = -(*b\VelocityY * *b\e)
EndIf
If *b\PositionX + *b\Radius >= #SECTOR_SIZE * #MAP_WIDTH_SECTORS
*b\PositionX = #SECTOR_SIZE * #MAP_WIDTH_SECTORS - *b\Radius
*b\VelocityX = -(*b\VelocityX * *b\e)
EndIf
If *b\PositionY + *b\Radius >= #SECTOR_SIZE * #MAP_HEIGHT_SECTORS
*b\PositionY = #SECTOR_SIZE * #MAP_HEIGHT_SECTORS - *b\Radius
*b\VelocityY = -(*b\VelocityY * *b\e)
EndIf
EndIf
; loop through neighbours
For i = 0 To NeighbourCount - 1
*e2 = *Neighbours(i)
If Not CollisionTestDone(*e1,*e2)
CreateCollisionTestRecord(*e1,*e2)
; handle ball-to-ball collisions
If *e1\Type = #ET_BALL And *e2\Type = #ET_BALL
*b1 = *e1
*b2 = *e2
;Debug "Checking for collision between ball " + Str(*b1\ID) + " and ball " + Str(*b2\ID)
If CirclesCollide(*b1\PositionX,*b1\PositionY,*b1\Radius,*b2\PositionX,*b2\PositionY,*b2\Radius)
;Debug "collision detected"
; Angle = ATan2(*b2\PositionY - *b1\PositionY,*b2\PositionX - *b1\PositionX)
;
; ;move balls apart
;
; Repeat
; *b1\PositionX = *b1\PositionX + 0.5 * Cos(Angle + #PI)
; *b1\PositionY = *b1\PositionY + 0.5 * Sin(Angle + #PI)
;
; *b2\PositionX = *b2\PositionX + 0.5 * Cos(Angle)
; *b2\PositionY = *b2\PositionY + 0.5 * Sin(Angle)
; Until Not CirclesCollide(*b1\PositionX,*b1\PositionY,*b1\Radius,*b2\PositionX,*b2\PositionY,*b2\Radius)
NormalX = *b2\PositionX - *b1\PositionX
NormalY = *b2\PositionY - *b1\PositionY
Distance = Sqr(Pow(*b1\PositionX - *b2\PositionX,2.0) + Pow(*b1\PositionY - *b2\PositionY,2.0))
Penetration = (*b1\Radius + *b2\Radius) - Distance
NormalLength = Sqr(Pow(NormalX,2.0) + Pow(NormalY,2.0))
;Debug "nl"
;Debug NormalLength
; this stops division by zero errors if the distance between the balls is tiny
If Abs(NormalLength) < 0.0001
Continue
;Debug "really tiny normal length"
EndIf
NormalX = NormalX / NormalLength
NormalY = NormalY / NormalLength
;Debug "normals"
;Debug NormalX
;Debug NormalY
CollisionPointX = 0.5 * (*b1\PositionX + *b1\Radius * NormalX) + 0.5 * (*b2\PositionX - *b2\Radius * NormalX)
CollisionPointY = 0.5 * (*b1\PositionY + *b1\Radius * NormalY) + 0.5 * (*b2\PositionY - *b2\Radius * NormalY)
*b1\PositionX = *b1\PositionX - 0.5 * Penetration * NormalX
*b1\PositionY = *b1\PositionY - 0.5 * Penetration * NormalY
*b2\PositionX = *b2\PositionX + 0.5 * Penetration * NormalX
*b2\PositionY = *b2\PositionY + 0.5 * Penetration * NormalY
;Debug *b1\PositionX
;Debug *b1\PositionY
RelativeVelocityX = *b1\VelocityX - *b2\VelocityX
RelativeVelocityY = *b1\VelocityY - *b2\VelocityY
VelocityDotNormal = Dot(RelativeVelocityX,RelativeVelocityY,NormalX,NormalY)
If VelocityDotNormal < 0.0
;Debug "continuing"
Continue
EndIf
ModifiedVelocity = VelocityDotNormal / (1.0 / *b1\Mass + 1.0 / *b2\Mass)
j1 = -(1.0 + *b1\e) * ModifiedVelocity
j2 = -(1.0 + *b2\e) * ModifiedVelocity
*b1\VelocityX = *b1\VelocityX + j1 / *b1\Mass * NormalX
*b1\VelocityY = *b1\VelocityY + j1 / *b1\Mass * NormalY
*b2\VelocityX = *b2\VelocityX - j2 / *b2\Mass * NormalX
*b2\VelocityY = *b2\VelocityY - j2 / *b2\Mass * NormalY
;Debug "col new vels"
;Debug *b1\VelocityX
;Debug *b1\VelocityY
EndIf
EndIf
EndIf
Next
*e1 = *e1\Next
Wend
Next
Next
For y = 0 To #MAP_HEIGHT_SECTORS - 1
For x = 0 To #MAP_WIDTH_SECTORS - 1
*e1 = MAP(x,y)\Occupants\First
While *e1
DestroyCollisionTestRecords(*e1)
*e1 = *e1\Next
Wend
Next
Next
EndProcedure
Procedure.l CirclesCollide(x1.f,y1.f,Radius1.f,x2.f,y2.f,Radius2.f)
If Sqr(Pow(x1 - x2,2.0) + Pow(y1 - y2,2.0)) <= (Radius1 + Radius2)
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.l IndexNeighbours(*e.Entity,Range)
Protected *i.Entity ; iterator
Protected x,y
Protected Width
Protected c = 0 ; counter
Protected Size = 16 ; current size of neighbours array
Protected XSector,YSector
If *e ;And Range > 0
XSector = Round(*e\PositionX / #SECTOR_SIZE,#PB_Round_Down)
YSector = Round(*e\PositionY / #SECTOR_SIZE,#PB_Round_Down)
If XSector >= 0 And XSector < #MAP_WIDTH_SECTORS And YSector >= 0 And YSector < #MAP_HEIGHT_SECTORS
Dim *NEIGHBOURS.Entity(Size)
; find nearby entities
For y = -Range To Range
Width = Sqr(Range * Range - y*y)
For x = -Width To Width
If (XSector + x) >= 0 And (XSector + x) < (#MAP_WIDTH_SECTORS)
If (YSector + y) >= 0 And (YSector + y) < (#MAP_HEIGHT_SECTORS)
*i = MAP(XSector + x,YSector + y)\Occupants\First
While *i
If *i <> *e
*NEIGHBOURS(c) = *i
c + 1
If c > Size
Size + 16
ReDim *NEIGHBOURS.Entity(Size)
EndIf
EndIf
*i = *i\Next
Wend
EndIf
EndIf
Next
Next
EndIf
EndIf
ProcedureReturn c
EndProcedure
Procedure.l CreateTimer(Freq)
Protected *Timer.Timer = AllocateMemory(SizeOf(Timer))
If *Timer
*Timer\Ticks = ElapsedMilliseconds()
*Timer\Freq = Freq
EndIf
ProcedureReturn *Timer
EndProcedure
Procedure.l WaitTimer(*Timer.Timer)
Protected Elapsed
Protected Pings
If *Timer
Repeat
Elapsed = ElapsedMilliseconds()
If Elapsed - *Timer\Ticks > *Timer\Freq
Break
EndIf
Delay(1)
ForEver
Pings = (Elapsed - *Timer\Ticks) / *Timer\Freq
*Timer\Ticks = *Timer\Ticks + *Timer\Freq * Pings
EndIf
ProcedureReturn Pings
EndProcedure
Procedure.l DestroyTimer(*Timer.Timer)
If *Timer
FreeMemory(*Timer)
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
Procedure.f Dot(x1.f,y1.f,x2.f,y2.f)
ProcedureReturn x1 * x2 + y1 * y2
EndProcedure
Procedure.f FMod(a.f,b.f)
Protected n.f
n.f = a/b
If n >= 0
n = Round(n,#PB_Round_Down)
Else
n = Round(n,#PB_Round_Up)
EndIf
ProcedureReturn a - n * b
EndProcedure
Procedure.l LLCreateElement(Size.l)
Protected *Element.LLElement = 0
*Element = AllocateMemory(Size)
ProcedureReturn *Element
EndProcedure
Procedure.l LLCreateElementList()
Protected *List.LLElementList
;Debug "allocating list " + Str(SizeOf(LLElementList)) + " bytes."
*List = AllocateMemory(SizeOf(LLElementList))
ProcedureReturn *List
EndProcedure
Procedure.l LLDestroyElement(*Element.LLElement)
;Debug "Destroying element."
Protected Result = 0
If *Element <> 0
If *Element\List <> 0
LLRemoveElement(*Element)
EndIf
;Debug "freeing element " + Str(MemorySize(*Element)) + " bytes."
FreeMemory(*Element)
Result = 1
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l LLDestroyElementList(*ElementList.LLElementList)
;Debug "Destroying element list."
;Debug "size = " + Str(*ElementList\Size)
Protected Result = 0
Protected *Element.LLElement
Protected *Element2.LLElement
Protected count.l
If *ElementList <> 0
*Element = *ElementList\First
While *Element <> 0
count = count + 1
;Debug "destroying element " + Str(count)
*Element2 = *Element\Next
;Debug "ahem"
If Not LLDestroyElement(*Element)
Result = 0
ProcedureReturn Result
EndIf
*Element = *Element2
Wend
;Debug "freeing element list " + Str(MemorySize(*ElementList)) + " bytes."
FreeMemory(*ElementList)
Result = 1
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l LLInsertElementBefore(*Element1.LLElement,*Element2.LLElement)
Protected Result = 0
If *Element1 <> 0
If *Element2 <> 0
If *Element2\List <> 0
If *Element1 <> *Element2
If *Element1\List <> 0
LLRemoveElement(*Element1)
EndIf
If *Element2 = *Element2\List\First
*Element2\List\First = *Element1
EndIf
*Element1\List = *Element2\List
*Element1\Previous = *Element2\Previous
*Element1\Next = *Element2
If *Element2\Previous
*Element2\Previous\Next = *Element1
EndIf
*Element2\Previous = *Element1
*Element2\List\Size = *Element2\List\Size + 1
Result = 1
EndIf
EndIf
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l LLInsertElementAfter(*Element1.LLElement,*Element2.LLElement)
Protected Result = 0
If *Element1 <> 0
If *Element2 <> 0
If *Element2\List <> 0
If *Element1 <> *Element2
If *Element1\List <> 0
LLRemoveElement(*Element1)
; Remove
EndIf
If *Element2 = *Element2\List\Last
*Element2\List\Last = *Element1
EndIf
*Element1\List = *Element2\List
*Element1\Next = *Element2\Next
*Element1\Previous = *Element2
If *Element2\Next
*Element2\Next\Previous = *Element1
EndIf
*Element2\Next = *Element1
*Element2\List\Size = *Element2\List\Size + 1
Result = 1
;Else
; Debug "Elements are the same."
EndIf
;Else
; Debug "Element2 isn't attached to a list."
EndIf
;Else
; Debug "Element2 is 0."
EndIf
;Else
; Debug "Element1 is 0"
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l LLAddElement(*Element.LLElement,*List.LLElementList)
Protected Result = 0
If *Element <> 0
If *List <> 0
If *Element\List <> 0
LLRemoveElement(*Element)
; Remove
EndIf
If *List\First = 0
*List\First = *Element
EndIf
If *List\Last <> 0
*List\Last\Next = *Element
*Element\Previous = *List\Last
EndIf
*List\Last = *Element
*Element\Next = 0
*Element\List = *List
*List\Size = *List\Size + 1
Result = 1
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l LLRemoveElement(*Element.LLElement)
Protected Result = 0
If *Element <> 0
If *Element\List <> 0
If *Element = *Element\List\First
*Element\List\First = *Element\Next
EndIf
If *Element = *Element\List\Last
*Element\List\Last = *Element\Previous
EndIf
If *Element\Previous <> 0
*Element\Previous\Next = *Element\Next
EndIf
If *Element\Next <> 0
*Element\Next\Previous = *Element\Previous
EndIf
*Element\List\Size = *Element\List\Size - 1
*Element\List = 0
*Element\Next = 0
*Element\Previous = 0
Result = 1
EndIf
EndIf
ProcedureReturn Result
EndProcedure