Quadtree - APUA!

Voit pyytää apua ohjelmointiongelmiin täältä.
Post Reply
User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Quadtree - APUA!

Post by Misthema » Thu Aug 01, 2013 9:05 am

Moro!

Pitkään hiljaisuudessa taas majailleena, innostuin CB:llä yrittämään nelipuu-järjestelmän tekoa. Noh, kaikki meni hyvin, kunnes yritin ajaa koodia... :D

Eli, kyseessä on taas jälleen MAV, mutta en vaan millään löydä, missä se aiheuttaja saattaisi olla... Joten tulin tänne ja nyt pyydän teiltä; APUA!

Koodia, joka löytyy myös täältä: http://www.cbrepository.com/pastebin/4B/

Code: Select all

// =================== POINT ==========================

Type Point
    Field x As Integer
    Field y As Integer
End Type

// Luo piste
Function CreatePoint( xx, yy )

    p.Point = New(Point)
    
    p\x = xx
    p\y = yy
    
    rtn = ConvertToInteger( p )
    
    Return rtn
End Function

// =================== RECTANGLE ==========================

Type Rectangle
    Field x As Integer
    Field y As Integer
    Field w As Integer
    Field h As Integer
End Type

// Luo neliö
Function CreateRectangle( xx, yy, ww, hh )

    rect.Rectangle = New(Rectangle)
    
    rect\x = xx
    rect\y = yy
    rect\w = ww
    rect\h = hh
    
    rtn = ConvertToInteger( rect )
    
    Return rtn
End Function

// Törmäävätkö neliöt
Function RectangleIntersects( inRect1, inRect2 )
    
    rect1.Rectangle = ConvertToType( inRect1 )
    rect2.Rectangle = ConvertToType( inRect2 )
    
    Return BoxOverlap( rect1\x, rect1\y, rect1\w, rect1\h, rect2\x, rect2\y, rect2\w, rect2\h )
End Function

// Onko piste neliön sisällä
Function IsInsideRectangle( inRect, inPoint )

    rect.Rectangle = ConvertToType( inRect )
    p.Point = ConvertToType( inPoint )
    
    If (p\x > rect\x) And (p\x < rect\x + rect\w) And (p\y > rect\y) And (p\y < rect\y + rect\h) Then
        Return True
    End If
    
    Return False
End Function

// =================== QUADTREE ==========================

Type Quadtree
    Field tileID As Integer

    Field rect As Integer
    Field nodesMem As Integer // Point luokan jäseniä

    Field topLeft As Integer
    Field topRight As Integer
    Field botLeft As Integer
    Field botRight As Integer
End Type

// Luo nelipuu
Function CreateQuadtree( inRect )

    qt.Quadtree = New( Quadtree )
    
    qt\rect = inRect
    qt\nodesMem = MakeMEMBlock( 1+ 4*4 )
    PokeByte qt\nodesMem, 0, 0 ' Ei yhtään nodea täällä
    
    rtn = ConvertToInteger( qt )
    
    Return rtn
End Function

// Luo lapsi-nodet
Function SubDivide( inQt )
    
    qt.Quadtree = ConvertToType( inQt )
    rect.Rectangle = ConvertToType( qt\rect )
    
    // Uudet neliöt lapsille (inQt:n neliö jaettuna 4 pienempään neliöön)
    topLeftRect = CreateRectangle( rect\x              , rect\y             , rect\w / 2, rect\h / 2 )
    topRightRect = CreateRectangle( rect\x + rect\w / 2, rect\y             , rect\w / 2, rect\h / 2 )
    botLeftRect = CreateRectangle( rect\x              , rect\y + rect\h / 2, rect\w / 2, rect\h / 2 )
    botRightRect = CreateRectangle( rect\x + rect\w / 2, rect\y + rect\h / 2, rect\w / 2, rect\h / 2 )
    
    // Uudet lapset
    qt\topLeft = CreateQuadtree( topLeftRect )
    qt\topRight = CreateQuadtree( topRightRect )
    qt\botLeft = CreateQuadtree( botLeftRect )
    qt\botRight = CreateQuadtree( botRightRect )
    
End Function

// Lisää nelipuuhun piste
// Palauttaa FALSE, mikäli piste ei mennyt/sopinut nelipuuhun
Function InsertToQuadtree( inQt, inPoint )

    qt.Quadtree = ConvertToType( inQt )
    p.Point = ConvertToType( inPoint )
    
    ' Jos piste ei oo neliön sisällä, se ei kuulu tänne
    If Not IsInsideRectangle( qt\rect, inPoint ) Then Return False
    
    nodesCount = PeekByte(qt\nodesMem, 0)
    
    ' Jos nodeja vielä mahtuu
    If nodesCount < 4 Then
        PokeInt qt\nodesMem, 1 + nodesCount * 4, inPoint
        PokeByte qt\nodesMem, 0, nodesCount + 1
        
        Return True ' Jeah, success!
    End If
    
    If( qt\topLeft = 0 ) Then SubDivide( inQt )
    
    // Koita tunkee Point johonkin lapsi-nodeen
    If( InsertToQuadtree( qt\topLeft , inPoint ) = False ) Then Return False
    If( InsertToQuadtree( qt\topRight, inPoint ) = False ) Then Return False
    If( InsertToQuadtree( qt\botLeft , inPoint ) = False ) Then Return False
    If( InsertToQuadtree( qt\botRight, inPoint ) = False ) Then Return False
    
    Return False // Point ei menny mihinkään, joku kusi tms
End Function

// Etsi ja palauta pisteet halutulta alueelta
// Palauttaa muistipalan
Function GetPointsFromArea( inQt, inRect )

    qt.Quadtree = ConvertToType( inQt )
    rect.Rectangle = ConvertToType( inRect )

    // Palautuspino
    rtnStack = CreateStack()
    
    // Katotaan onko tämä quadtree-node haetun neliön sisällä
    If Not RectangleIntersects( inRect, qt\rect ) Then Return rtnStack
    
    nodesCount = PeekByte( qt\nodesMem, 0 )
    
    For i = 0 To nodesCount - 1
        
        // Pisteen muistiosoite
        point = PeekInt( qt\nodesMem, 1 + i * 4 )
        
        If IsInsideRectangle( inRect, point ) Then
            Push( rtnStack, point )
        End If
    Next i
    
    // Jos ei ole lapsia, palauta pino
    If qt\topLeft = 0 Then Return rtnStack
    
    MergeStacks( rtnStack, GetPointsFromArea( qt\topLeft, inRect ) )
    MergeStacks( rtnStack, GetPointsFromArea( qt\topRight, inRect ) )
    MergeStacks( rtnStack, GetPointsFromArea( qt\botLeft, inRect ) )
    MergeStacks( rtnStack, GetPointsFromArea( qt\botRight, inRect ) )
    
    Return rtnStack
End Function


// =================== STACK ==========================

// Luo pino
Function CreateStack()
    
    mem = MakeMEMBlock(1)
    
    PokeByte mem, 0, 0
    
    Return mem
End Function

// Työnnä pinoon
Function Push( stack, in )

    stackSize = PeekByte( stack, 0 )
    ResizeMEMBlock stack, stackSize + 4
    PokeByte stack, 0, stackSize + 4
    
    PokeInt stack, stackSize, in
End Function

// Palauta pinosta
Function Pop( stack )

    stackSize = PeekByte( stack, 0 )

    rtn = PeekInt( stack, stackSize - 4 )
    
    ResizeMEMBlock stack, stackSize - 4
    PokeByte stack, 0, stackSize - 4
    
    Return rtn
End Function

// Yhdistä kaksi pinoa
Function MergeStacks( stack, fromStack )
    
    count = PeekByte( stack, 0 )
    
    For i = 0 To count - 1
        Push( stack, Pop( fromStack ) )
    Next i
    
    Return stack
End Function


// ======================= EXAMPLE ========================

qRect = CreateRectangle( 0, 0, 100, 100 ) // Luodaan uusi alue
qTree = CreateQuadtree( qRect ) // Luodaan uusi quadtree

// Luodaan pisteet
For i = 0 To 10
    point = CreatePoint( Rand(1,99), Rand(1,99) )
    
    InsertToQuadtree( qTree, point )
Next i

// Luodaan alue, jolta haetaan pisteet
aRect = CreateRectangle( 25, 25, 50, 50 )

// Etsitään ja haetaan kaikki pisteet alueelta
points = GetPointsFromArea( qTree, aRect )

// Käydään saadut pisteet läpi, ja piirretään ne ruudulle
Box 0,0,100,100, 0 // Quadtreen alue
Box 25,25,50,50, 0 // Haku alue

For i = 0 To PeekByte( points, 0 ) - 1
    p.Point = ConvertToType( Pop( points ) )
    
    Circle p\x-1, p\y-1, 3
Next i

DrawScreen
WaitKey
End

Function WriteLog(_text$)

    If FileExists( "debug.txt" ) = 0 Then
        fo = OpenToWrite( "debug.txt" )
            WriteLine f, LSet(Date() + " " + Time(), 22) + _text
        CloseFile fo
        Return False
    Else
    
        fs = FileSize("debug.txt")
        
        f = OpenToEdit("debug.txt")
        SeekFile f, fs
        WriteLine f, LSet(Date() + " " + Time(), 22) + _text
        CloseFile f
    End If
EndFunction

User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Re: Quadtree - APUA!

Post by Misthema » Thu Aug 01, 2013 10:09 am

Okei, nyt jo alko ratkeemaan. Pissi toooodella pahasti nuo pinot... Noh, kyllä tämä tästä! Ja unohtakaa ylläoleva koodi ja linkki, näemmä jotain ihan utopiaa pastesin :D Koodi on jo osissa ja erilainen...

Post Reply

Who is online

Users browsing this forum: No registered users and 7 guests