Pitkään hiljaisuudessa taas majailleena, innostuin CB:llä yrittämään nelipuu-järjestelmän tekoa. Noh, kaikki meni hyvin, kunnes yritin ajaa koodia...
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