Need good quadtree tutorial

General FreeBASIC programming questions.
Post Reply
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Need good quadtree tutorial

Post by duke4e »

Hey, could someone try to make a quadetree version of program below? I know that there is Rel's quadtree tutorial, but I just find it really hard and confusing to read and I whould really need a quadtree collision detection optimisation. Google wasn't of much help either... Also, this could be very useful to many people searching for collision detection speedup.

Code: Select all

#include "fbgfx.bi"
Using FB

Const xres = 800
Const yres = 600
Const MaxCircles = 50

Screenres xres, yres, 32

Type TCircle
    x As Single
    y As Single
    angle As Single
    r As Single
    isColliding As Integer
End Type
Dim Shared As TCircle Circles(MaxCircles)


Sub Init()
    For i As Integer = 0 To MaxCircles - 1
        Circles(i).x = Rnd * xres
        Circles(i).y = Rnd * yres
        Circles(i).angle = Rnd * 6.28
        Circles(i).r = 10 + (Rnd * 20)
    Next
End Sub

Sub Update()
    For i As Integer = 0 To MaxCircles - 1
        Circles(i).isColliding = 0
        Circles(i).x += Cos(Circles(i).angle)
        Circles(i).y += Sin(Circles(i).angle)
        
        If Circles(i).x > xres Or Circles(i).x < 0 Or Circles(i).y > yres Or Circles(i).y < 0 Then
            Circles(i).x = Rnd * xres
            Circles(i).y = Rnd * yres
            Circles(i).angle = Rnd * 6.28
            Circles(i).r = 10 + (Rnd * 20)
        End If
    Next
    
    For i As Integer = 0 To MaxCircles - 2
        For j As Integer = i + 1 To MaxCircles - 1
            Dim As Single dx = Circles(i).x - Circles(j).x
            Dim As Single dy = Circles(i).y - Circles(j).y
            Dim As Single dist = Sqr(dx*dx+dy*dy)
            If dist < Circles(i).r + Circles(j).r Then
                Circles(i).isColliding = 1
                Circles(j).isColliding = 1
            End If
        Next    
    Next    
End Sub

Sub Render()
    For i As Integer = 0 To MaxCircles - 1
        If Circles(i).isColliding = 0 Then Circle (Circles(i).x, Circles(i).y), Circles(i).r Else Circle (Circles(i).x, Circles(i).y), Circles(i).r, Rgb(255, 0, 0)
    Next
End Sub

Init()
Do
    Update()
    
    
    Screenlock
    Cls
    Render()
    Screenunlock
    Sleep 1
Loop Until Multikey(SC_ESCAPE)
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:

Post by relsoft »

Quadtrees would be useless in what you're doing. Quadtrees are good for collision between a static environment and a moving object.

If you need a fast particle collision routine between moving objects, you might want to go with "sphere trees" or a grid based system Hugo Elias used in his "smoke" demo.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

Correct me if i'm wrong, but this looks like quadtree based collision detection.

http://lab.polygonal.de/2007/09/09/quad ... nstration/
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:

Post by relsoft »

duke4e wrote:Correct me if i'm wrong, but this looks like quadtree based collision detection.

http://lab.polygonal.de/2007/09/09/quad ... nstration/
A grid based system or a sphere tree should be faster. Quadtrees are slow to make in realtime.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

Is this the grid based system you're talking about? Code is a little messy, but it mostly works. Tutorials/example code/links are always welcome.

Code: Select all

#include "fbgfx.bi"
Using FB

Const xres = 800
Const yres = 600
Const MaxCircles = 5000

Screenres xres, yres, 32

Const GridSize = 10
Const GridSizeHalf = GridSize / 2
Const GridX = (xres / GridSize)
Const GridY = (yres / GridSize)


Type TCircle
    x As Single
    y As Single
    angle As Single
    r As Single
    isColliding As Integer
End Type
Dim Shared As TCircle Circles(MaxCircles)

Type TGrid
    elements As Integer
    id(MaxCircles) As Integer 
End Type
Dim Shared As TGrid Grid(GridX, GridY)


Sub Init()
    For i As Integer = 0 To MaxCircles - 1
        Circles(i).x = Rnd * xres
        Circles(i).y = Rnd * yres
        Circles(i).angle = Rnd * 6.28
        Circles(i).r = GridSizeHalf
    Next
End Sub

Sub Update()
    For x As Integer = 0 To GridX - 1
        For y As Integer = 0 To GridY - 1
            Grid(x, y).elements = 0
        Next    
    Next       
    
    For i As Integer = 0 To MaxCircles - 1
        Circles(i).isColliding = 0
        Circles(i).x += Cos(Circles(i).angle)
        Circles(i).y += Sin(Circles(i).angle)
        
        If Circles(i).x > xres Or Circles(i).x < 0 Or Circles(i).y > yres Or Circles(i).y < 0 Then
            Circles(i).x = Rnd * xres
            Circles(i).y = Rnd * yres
            Circles(i).angle = Rnd * 6.28
            Circles(i).r = GridSizeHalf
        End If
        
        Dim As Integer x1 = Fix((Circles(i).x - GridSizeHalf) / GridSize)
        Dim As Integer y1 = Fix((Circles(i).y - GridSizeHalf) / GridSize)
        Dim As Integer x2 = Fix((Circles(i).x + GridSizeHalf) / GridSize)
        Dim As Integer y2 = Fix((Circles(i).y + GridSizeHalf) / GridSize)
        Grid(x1, y1).id(Grid(x1, y1).elements) = i
        Grid(x2, y1).id(Grid(x2, y1).elements) = i
        Grid(x1, y2).id(Grid(x1, y2).elements) = i
        Grid(x2, y2).id(Grid(x2, y2).elements) = i
        
        Grid(x1, y1).elements += 1
        Grid(x2, y1).elements += 1
        Grid(x1, y2).elements += 1
        Grid(x2, y2).elements += 1        
    Next
    
    For x As Integer = 1 To GridX - 2
        For y As Integer = 1 To GridY - 2
            For i As Integer = 0 To Grid(x, y).elements - 1
                For xx As Integer = x - 1 To x + 1
                    For yy As Integer = y - 1 To y + 1
                        If xx <> x And yy <> y Then
                            For j As Integer = 0 To Grid(xx, yy).elements - 1
                                If Grid(x, y).id(i) <> Grid(xx, yy).id(j) Then
                                    Dim As Single dx = Circles(Grid(x, y).id(i)).x - Circles(Grid(xx, yy).id(j)).x
                                    Dim As Single dy = Circles(Grid(x, y).id(i)).y - Circles(Grid(xx, yy).id(j)).y
                                    Dim As Single dist = Sqr(dx*dx+dy*dy)
                                    If dist < Circles(Grid(x, y).id(i)).r + Circles(Grid(xx, yy).id(j)).r Then
                                        Circles(Grid(x, y).id(i)).isColliding = 1
                                        Circles(Grid(xx, yy).id(j)).isColliding = 1
                                    End If
                                End If
                            Next
                        End If
                    Next    
                Next    
            Next    
        Next    
    Next       

    
    
    /'
    For i As Integer = 0 To MaxCircles - 2
        For j As Integer = i + 1 To MaxCircles - 1
            Dim As Single dx = Circles(i).x - Circles(j).x
            Dim As Single dy = Circles(i).y - Circles(j).y
            Dim As Single dist = Sqr(dx*dx+dy*dy)
            If dist < Circles(i).r + Circles(j).r Then
                Circles(i).isColliding = 1
                Circles(j).isColliding = 1
            End If
        Next   
    Next
    '/
End Sub

Sub Render()
    For x As Integer = 0 To GridX - 1
        For y As Integer = 0 To GridY - 1
            If Grid(x, y).elements = 0 Then
                'Line(x * GridSize, y * GridSize)-((x * GridSize) + GridSize, (y * GridSize) + GridSize),, b
            Else
                'Line(x * GridSize, y * GridSize)-((x * GridSize) + GridSize, (y * GridSize) + GridSize), Rgb(255, 0, 0), bf
            End If
        Next    
    Next    
    
    For i As Integer = 0 To MaxCircles - 1
        If Circles(i).isColliding = 0 Then Circle (Circles(i).x, Circles(i).y), Circles(i).r Else Circle (Circles(i).x, Circles(i).y), Circles(i).r, Rgb(255, 0, 0)
    Next
End Sub

Init()
Do
    Update()
    
    
    Screenlock
    Cls
    Render()
    Screenunlock
    Sleep 1
Loop Until Multikey(SC_ESCAPE)
rdc
Posts: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Post by rdc »

I came across the Sphere Tree Construction Kit the other day:

http://isg.cs.tcd.ie/spheretree/

They have example code and several implementations. Maybe it will help.
Voltage
Posts: 110
Joined: Nov 19, 2005 7:36
Location: Sydney, Australia
Contact:

Post by Voltage »

Wow that is a good link. Thanks Rick.

@duke: I've written a quadtree renderer in FB. It only renders a static world, not a moving collection of objects, but I have read an article where the author was describing a method to move objects in a quad tree.

I reckon you could do it.

'I've written a quadtree renderer in FB" - Looks like I've lost the latest version. This one has most of the code for the quadtree, just needs a routine to draw the leaf nodes. Anyway it works without the quadtree in place at the moment. Use mouse to look, and mouse buttons to move. Esc exits.

http://www.2shared.com/file/12041448/2a ... dTree.html
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:

Post by relsoft »

Duke4e: Sorry can't test code, no FB in this comp.

This is the grid system Hugo Elias used:

http://freespace.virgin.net/hugo.elias/ ... colide.htm

Also if you are able to use AABBs, you could use sweep and prune.

http://www.shmup-dev.com/forum/index.ph ... 635.0.html

The idea of a sphereTree is so unlike a quadtree or an octree for that matter. What sphere trees do is like a venn-diagram.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

Thanks guys for links, some useful stuff there!
rdc
Posts: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Post by rdc »

Voltage wrote:Wow that is a good link. Thanks Rick.
You're welcome. That cow is the best. I just had to laugh. :)
Post Reply