  | 
					
						Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!   
						
						
					 | 
				 
			 
			 
	
		| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen   | 
	 
	
	
		| Autor | 
		Nachricht | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 19.05.2012, 15:52    Titel: Quadtree | 
				     | 
			 
			
				
  | 
			 
			
				Hi zusammen,
 
 
wollte nach längerer Zeit mal wieder etwas neues probieren nachdem ich mich durch die OpenGL Welt gelesen und getestet habe und mir irgendwie schwindelig wurde bei den notwendigen Vorarbeiten eines 'Grundgerüsts' um überhaupt etwas sinnvolles damit anfangen zu können...
 
 
Im Moment hänge ich am eine wohl wichtigsten Element, dem Quadtree
 
das ich mir zu test und übungszwecken erstmal auf 2D fbgfx ebende zusammengebastelt habe.
 
 
Erste Versuche klappten super, mit 1-10 'Objekten' kein problem...
 
wollte das ganze dann mal etwas übertreiben mit 1000, aber da ging nichts und runtergetestet habe ich nun auf 50 und auch da kommt es zu einem Speicherüberlauf...
 
 
Bin für jeden Tipp und Verbesserungsvorschlag dankbar  
 
 
 	  | Code: | 	 		  
 
Sub CMsg (byval Msg as String)
 
    Dim FF as integer
 
    FF = FreeFile
 
    Open CONS for Output as #FF
 
    print #FF, Msg
 
    Close #FF
 
End Sub
 
 
Type OBJList
 
    minX as single
 
    minZ as single
 
    
 
    maxX as single
 
    maxZ as single
 
    
 
    Color as Integer
 
End Type
 
 
Type test_QuadTree
 
    minX as single
 
    minZ as single
 
    
 
    maxX as Single
 
    maxZ as Single
 
    
 
    Node(0 to 3) as test_QuadTree ptr
 
    
 
    IsSplit as byte
 
    
 
    Declare Sub Split()
 
    
 
    Declare Sub AddObj(MyObj as OBJList ptr)
 
    
 
    Declare Sub Draw()
 
        
 
    Objects   as OBJList ptr ptr
 
    OBJ_Count as Integer
 
    
 
    maxSplit  as Integer
 
End Type
 
 
Sub test_QuadTree.Split()
 
    Dim CenterX as Single
 
    Dim CenterZ as Single
 
    
 
    'CenterX = (this.minX + this.maxX) / 2
 
    'CenterZ = (this.minZ + this.maxZ) / 2
 
 
    CenterX = this.minX + ((this.maxX - this.minX) / 2)
 
    CenterZ = this.minZ + ((this.maxZ - this.minZ) / 2)
 
 
 
    this.IsSplit = 1
 
    
 
    this.Node(0) = new test_Quadtree
 
        this.Node(0) -> minX = this.minX
 
        this.Node(0) -> minZ = this.minZ
 
        this.Node(0) -> maxX = CenterX
 
        this.Node(0) -> maxZ = CenterZ
 
        this.Node(0) -> maxSplit = this.maxSplit+1
 
        
 
    this.Node(1) = new test_Quadtree
 
        this.Node(1) -> minX = CenterX
 
        this.Node(1) -> minZ = this.minZ
 
        this.Node(1) -> maxX = this.maxX
 
        this.Node(1) -> maxZ = CenterZ
 
        this.Node(1) -> maxSplit = this.maxSplit+1
 
        
 
    this.Node(2) = new test_Quadtree
 
        this.Node(2) -> minX = this.minX
 
        this.Node(2) -> minZ = CenterZ
 
        this.Node(2) -> maxX = CenterX
 
        this.Node(2) -> maxZ = this.maxZ
 
        this.Node(2) -> maxSplit = this.maxSplit+1
 
        
 
    this.Node(3) = new test_Quadtree
 
        this.Node(3) -> minX = CenterX
 
        this.Node(3) -> minZ = CenterZ
 
        this.Node(3) -> maxX = this.maxX
 
        this.Node(3) -> maxZ = this.maxZ
 
        this.Node(3) -> maxSplit = this.maxSplit+1
 
End Sub
 
    
 
    
 
    
 
Sub test_QuadTree.AddObj(MyOBJ as OBJList ptr)
 
    Dim as Single minX, minZ, maxX, maxZ
 
    Dim CenterX as Single
 
    Dim CenterZ as Single
 
    Dim Temp as any ptr
 
    
 
    minX = MyOBJ -> minX
 
    minZ = MyOBJ -> minZ
 
    maxX = MyOBJ -> maxX
 
    maxZ = MyOBJ -> maxZ
 
    
 
    'CenterX = (this.minX + this.maxX) / 2
 
    'CenterZ = (this.minZ + this.maxZ) / 2
 
    
 
    CenterX = this.minX + ((this.maxX - this.minX) / 2)
 
    CenterZ = this.minZ + ((this.maxZ - this.minZ) / 2)
 
    
 
    'CMsg "OBJ: min "+str(minX)+","+str(minZ) + " Node: min "+str(this.minX)+","+str(this.minZ)
 
    'CMsg "OBJ: max "+str(maxX)+","+str(maxZ) + " Node: max "+str(this.maxX)+","+str(this.maxZ)
 
    
 
    'line (minX,minZ) - (maxX, maxZ), &hFFFF0000, B
 
    
 
    If (minX >= this.minX) and (minZ >= this.minZ) and (maxX <= this.maxX) and (maxZ <= this.maxZ) Then
 
        'Is Storable!
 
        
 
        If this.maxSplit < 4 Then
 
        
 
        If (minX >= this.minX) and (minZ >= this.minZ) and (maxX <= CenterX) and (maxZ <= CenterZ) Then ''Upper Left
 
            'Is Splitable? 
 
            If this.IsSplit=0 then this.Split()
 
            this.Node(0) -> AddObj(MyOBJ)
 
            Exit Sub
 
        End If
 
        
 
        If (minX >= CenterX) and (minZ >= this.minZ) and (maxX <= this.maxX) and (maxZ <= CenterZ) Then ''Upper Right
 
            'Is Splitable? 
 
            If this.IsSplit=0 then this.Split()
 
            this.Node(1) -> AddObj(MyOBJ)
 
            Exit Sub
 
        End If
 
                
 
        If (minX >= this.minX) and (minZ >= CenterZ) and (maxX <= CenterX) and (maxZ <= this.maxZ) Then ''Bottom Left
 
            'Is Splitable? 
 
            If this.IsSplit=0 then this.Split()
 
            this.Node(2) -> AddObj(MyOBJ)
 
            Exit Sub
 
        End If
 
 
        If (minX >= CenterX) and (minZ >= CenterZ) and (maxX <= this.maxX) and (maxZ <= this.maxZ) Then ''Bottom Right
 
            'Is Splitable? 
 
            If this.IsSplit=0 then this.Split()
 
            this.Node(3) -> AddObj(MyOBJ)
 
            Exit Sub
 
        End If
 
        
 
        End If
 
        'Store it here!
 
        Temp = reallocate(this.Objects,this.OBJ_Count+1)
 
        this.Objects = Temp
 
        
 
        this.Objects[this.OBJ_Count] = MyOBJ
 
        this.OBJ_Count += 1
 
        Exit Sub
 
    
 
    
 
    End If
 
    CMsg "Not Stored!"
 
End Sub
 
 
Sub test_QuadTree.Draw()
 
    'Debugline
 
    line (this.minX, this.minZ) - (this.maxX, this.maxZ), &hFF909090, B
 
    
 
    If this.OBJ_Count Then
 
        for i as integer=0 to this.OBJ_Count-1
 
            line (this.Objects[i] -> minX, this.Objects[i] -> minZ) - (this.Objects[i] -> maxX, this.Objects[i] -> maxZ), this.Objects[i] -> Color, BF
 
        next i
 
    End If
 
    
 
    If this.IsSplit Then 
 
        this.Node(0) -> Draw()
 
        this.Node(1) -> Draw()
 
        this.Node(2) -> Draw()
 
        this.Node(3) -> Draw()
 
    End If
 
End Sub
 
 
 
 
 
''''Testit
 
Randomize Timer
 
screen 19,32
 
 
Dim TestBaum as test_QuadTree
 
TestBaum.minX=0 : TestBaum.maxX=799
 
TestBaum.minZ=0 : TestBaum.maxZ=599
 
 
Dim testObjects as OBJList ptr
 
testObjects = new OBJList [50]
 
 
Dim rndStartX as integer
 
Dim rndStartY as integer
 
Dim rndSize   as integer
 
Dim rndColor  as Integer
 
 
for i as integer=0 to 49
 
 
    rndStartX = rnd * 800
 
    rndStartY = rnd * 600
 
    rndSize   = rnd * 50
 
    rndColor  = rnd * &hFFFFFF
 
    
 
    If (rndStartX+rndSize) > 799 Then rndStartX -= rndSize
 
    If (rndStartY+rndSize) > 599 Then rndStartY -= rndSize
 
    
 
    testObjects[i].minX  = rndStartX
 
    testObjects[i].minZ  = rndStartY
 
    testObjects[i].maxX  = rndStartX+rndSize
 
    testObjects[i].maxZ  = rndStartY+rndSize 
 
    testObjects[i].Color = rndColor
 
 
    TestBaum.AddObj (@testObjects[i])
 
next i
 
 
 
 
TestBaum.Draw()
 
    
 
 
sleep
 
 | 	 
  _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		MisterD
 
  
  Anmeldungsdatum: 10.09.2004 Beiträge: 3071 Wohnort: bei Darmstadt
  | 
		
			
				 Verfasst am: 19.05.2012, 17:52    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				so ganz spontan: (@testObjects[i]) ist das äquivalent zu (@(testObjects[i])) oder ((@testObjects)[i])?
 
 
ansonsten als idee: kriegst du zufällig vllt n speicherüberlauf wenn du in deinen baum zwei objekte mit identischen koordinaten steckst weil er dann endlos splitted oder sowas?
 
 
wenn alles nix hilft: a) debuggen oder b) (besser) ordentliche testcases schreiben. _________________ "It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
 
Edsger W. Dijkstra | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 20.05.2012, 13:30    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				Ne das mit der Übergabe war schon richtig so da es eine 'ptr ptr' war und das mit dem endlos splitten hatte ich schon mit der maxsplit verhindert das es sich nur 4 bzw 3 mal teilt wobei gleiche koordinaten gar kein problem darstellen sondern einfach hinein gespeichert werden unabhängig ob an selber stelle schon was ist oder nicht...
 
 
Wo hier das problem liegt weiss ich leider immernoch nicht genau, hab das ganze gestern abend nochmal komplett neu geschrieben und funktioniert nun tadellos (getestet mit mehreren 100000 Objekten)
 
 
Ein einziges 'Gedankenproblem' das mir aber aufgekommen ist, wenn ich zB ein Objekt habe das sich wegen seiner grösse und koordinaten in einen übergeordneteten Node speichert der später evtl wegen des Frustums 'ignoriert' wird obwohl er grösstenteils in den tieferen Nodes 'zu sehen' ist...
 
Dieser wird obwohl ich dann evtl quasi direkt davor stehe nicht gezeichnet und somit nicht sichtbar sein obwohl er ja an dieser stelle sein soll?!
 
 
Weiss dazu leider noch keine Lösung... _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		MisterD
 
  
  Anmeldungsdatum: 10.09.2004 Beiträge: 3071 Wohnort: bei Darmstadt
  | 
		
			
				 Verfasst am: 20.05.2012, 15:55    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				trag ein objekt einfach in jedem blatt ein in dem es drin liegt, nicht in den zwischenknoten. _________________ "It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
 
Edsger W. Dijkstra | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 20.05.2012, 16:28    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				Wäre wohl eine möglichkeit, 
 
gerade noch hab ich getestet ob mein Problem nicht schon behoben würde wenn ich jedes Node mit allen Objekten zeichne das nur 'teilweise' in meiner Kamera zu sehen ist aber da hab ich das grosse problem das ich grössere objekte die sich zB im obersten node befinden gar nicht mehr sehe da es aufgrund meiner kamera grösse eigentlich nie gezeichnet wird...
 
 
riskiere ich mit der Möglichkeit nicht aber auch das ich Objekte mehrfach zeichne?
 
 
kleines Beispiel zum rumspielen  
 
 	  | Code: | 	 		  
 
Sub CMsg (byval Msg as String)
 
    Dim FF as integer
 
    FF = FreeFile
 
    Open CONS for Output as #FF
 
    print #FF, Msg
 
    Close #FF
 
End Sub
 
 
Const MaxDepth as Integer = 4
 
 
Type Object_
 
    minx as single
 
    minz as single
 
    maxx as single
 
    maxz as single
 
    col  as integer
 
end type
 
 
Type Quadtree
 
    Declare Constructor()
 
    Declare Constructor(minX as single, minZ as single, maxX as single, maxZ as single, D as UByte = 0)
 
    
 
    QT_minX as single
 
    QT_minZ as single
 
    QT_maxX as single
 
    QT_maxZ as single
 
    
 
    Node(0 to 3) as Quadtree ptr
 
    
 
    Declare Sub Split()
 
    Declare Sub Draw(viewminx as single, viewminz as single, viewmaxx as single, viewmaxz as single)
 
    
 
    IsSplit as UByte
 
    Depth   as UByte
 
    
 
    Declare Sub AddObject(Objptr as Object_ ptr)
 
    
 
    Objects  as Object_ ptr ptr
 
    ObjCount as Integer
 
End Type
 
 
Constructor Quadtree()
 
    this.QT_minX = 0 : this.QT_minZ = 0
 
    this.QT_maxX = 0 : this.QT_maxZ = 0
 
    this.IsSplit = 0 : ObjCount = 0 : Depth = 0
 
End Constructor
 
 
Constructor Quadtree(minX as single, minZ as single, maxX as single, maxZ as single, D as UByte = 0)
 
    this.QT_minX = minX : this.QT_minZ = minZ
 
    this.QT_maxX = maxX : this.QT_maxZ = maxZ
 
    this.IsSplit = 0    : ObjCount = 0
 
    this.Depth   = D 
 
    
 
    'CMsg "Node created"
 
    'CMsg str(this.QT_minX)+","+str(this.QT_minZ)
 
    'CMsg str(this.QT_maxX)+","+str(this.QT_maxZ)
 
End Constructor
 
 
Sub Quadtree.Split()
 
    Dim CenterX as single
 
    Dim CenterZ as single
 
    
 
    CenterX = this.QT_minX + ((this.QT_maxX - this.QT_minX) / 2)
 
    CenterZ = this.QT_minZ + ((this.QT_maxZ - this.QT_minZ) / 2)
 
    
 
    Node(0) = NEW Quadtree
 
    *Node(0) = type(this.QT_minX, this.QT_minZ, CenterX, CenterZ, this.Depth+1)
 
    
 
    Node(1) = NEW Quadtree
 
    *Node(1) = type(CenterX, this.QT_minZ, this.QT_maxX, CenterZ, this.Depth+1)
 
    
 
    Node(2) = NEW Quadtree
 
    *Node(2) = type(this.QT_minX, CenterZ, CenterX, this.QT_maxZ, this.Depth+1)
 
    
 
    Node(3) = NEW Quadtree
 
    *Node(3) = type(CenterX, CenterZ, this.QT_maxX, this.QT_MaxZ, this.Depth+1)
 
    
 
    this.IsSplit = 1
 
End Sub
 
 
Sub Quadtree.AddObject(Objptr as Object_ ptr)
 
    Dim CenterX as single
 
    Dim CenterZ as single
 
    
 
    CenterX = this.QT_minX + ((this.QT_maxX - this.QT_minX) / 2)
 
    CenterZ = this.QT_minZ + ((this.QT_maxZ - this.QT_minZ) / 2)
 
    
 
    Dim Temp as any ptr
 
    
 
    ''Main
 
    If ((Objptr -> minx) >= this.QT_minX) and ((Objptr -> minz) >= this.QT_minZ) and _
 
       ((Objptr -> maxx) <= this.QT_maxX) and ((Objptr -> maxz) <= this.QT_maxZ) Then
 
       
 
        If (this.Depth < MaxDepth) Then
 
           
 
            ''Upper left
 
            If ((Objptr -> minx) >= this.QT_minX) and ((Objptr -> minz) >= this.QT_minZ) and _
 
               ((Objptr -> maxx) <= CenterX) and ((Objptr -> maxz) <= CenterZ) Then
 
           
 
               If (this.IsSplit = 0) Then this.Split()
 
               this.Node(0) -> AddObject(Objptr)
 
               Exit Sub
 
            End If
 
            
 
            ''Upper right
 
            If ((Objptr -> minx) >= CenterX) and ((Objptr -> minz) >= this.QT_minZ) and _
 
               ((Objptr -> maxx) <= this.QT_maxX) and ((Objptr -> maxz) <= CenterZ) Then
 
           
 
               If (this.IsSplit = 0) Then this.Split()
 
               this.Node(1) -> AddObject(Objptr)
 
               Exit Sub
 
            End If
 
       
 
            ''Bottom left
 
            If ((Objptr -> minx) >= this.QT_minX) and ((Objptr -> minz) >= CenterZ) and _
 
               ((Objptr -> maxx) <= CenterX) and ((Objptr -> maxz) <= this.QT_maxZ) Then
 
           
 
               If (this.IsSplit = 0) Then this.Split()
 
               this.Node(2) -> AddObject(Objptr)
 
               Exit Sub
 
            End If
 
 
            ''Bottom right
 
            If ((Objptr -> minx) >= CenterX) and ((Objptr -> minz) >= CenterZ) and _
 
               ((Objptr -> maxx) <= this.QT_maxX) and ((Objptr -> maxz) <= this.QT_maxZ) Then
 
           
 
               If (this.IsSplit = 0) Then this.Split()
 
               this.Node(3) -> AddObject(Objptr)
 
               Exit Sub
 
            End If
 
        End If
 
        
 
        Temp = reallocate (Objects, (this.ObjCount+1)*4)
 
        Objects = Temp
 
        
 
        Objects[ObjCount] = Objptr
 
        
 
        this.ObjCount += 1
 
        CMsg "Object stored : bounding box("+str(Objptr -> minx)+","+str(Objptr -> minz)+")-("+str(Objptr -> maxx)+","+str(Objptr -> maxz)+")"
 
        Exit Sub
 
    End If
 
    CMsg "Object not stored : bounding box("+str(Objptr -> minx)+","+str(Objptr -> minz)+")-("+str(Objptr -> maxx)+","+str(Objptr -> maxz)+")"
 
End Sub
 
 
Function IsIn(x as single, z as single, minx as single, minz as single, maxx as single, maxz as single) as integer
 
    If (x >= minx) and (z >= minz) and (x <= maxx) and (z <= maxz) then return 1
 
    
 
    return 0
 
End Function
 
    
 
 
Sub Quadtree.Draw(viewminx as single, viewminz as single, viewmaxx as single, viewmaxz as single)
 
    
 
    If IsIn(this.QT_minX,this.QT_minZ,viewminx,viewminz,viewmaxx,viewmaxz)=1 or _
 
       IsIn(this.QT_maxX,this.QT_minZ,viewminx,viewminz,viewmaxx,viewmaxz)=1 or _
 
       IsIn(this.QT_minX,this.QT_maxZ,viewminx,viewminz,viewmaxx,viewmaxz)=1 or _
 
       IsIn(this.QT_maxX,this.QT_maxZ,viewminx,viewminz,viewmaxx,viewmaxz)=1 Then
 
    
 
    
 
    If (this.ObjCount > 0) Then
 
        'debug line
 
        line (this.QT_minX, this.QT_minZ) - (this.QT_maxX, this.QT_maxZ), &hFF909090, B
 
        
 
        for i as integer=0 to this.ObjCount-1
 
            line (this.Objects[i] -> minx, this.Objects[i] -> minz) - (this.Objects[i] -> maxx, this.Objects[i] -> maxz), this.Objects[i] -> col, BF
 
        next i
 
    End If
 
    
 
    End If 
 
 
    If (this.IsSplit > 0) Then
 
        this.Node(0) -> Draw(viewminx, viewminz, viewmaxx, viewmaxz)
 
        this.Node(1) -> Draw(viewminx, viewminz, viewmaxx, viewmaxz)
 
        this.Node(2) -> Draw(viewminx, viewminz, viewmaxx, viewmaxz)
 
        this.Node(3) -> Draw(viewminx, viewminz, viewmaxx, viewmaxz)
 
    End If
 
End Sub
 
 
Randomize Timer
 
screen 19,32
 
 
Dim MyTree as Quadtree ptr = new Quadtree
 
*MyTree = type(0,0,800,600)
 
 
Dim TestOBJ as Object_ ptr ptr 
 
TestOBJ = callocate(100*4)
 
 
Dim as Integer rndStartX, rndStartZ, rndSize, rndColor
 
 
for i as integer=0 to 99
 
    rndStartX = rnd * 800
 
    rndStartZ = rnd * 600
 
    rndSize   = rnd * 150
 
    rndColor  = rnd * &hFFFFFF
 
         
 
    TestOBJ[i] = new Object_
 
    TestOBJ[i] -> minx = rndStartX
 
    TestOBJ[i] -> minz = rndStartZ
 
    TestOBJ[i] -> maxx = rndStartX + rndSize
 
    TestOBJ[i] -> maxz = rndStartZ + rndSize
 
    TestOBJ[i] -> col  = rndColor
 
    
 
    MyTree -> AddObject(TestOBJ[i])
 
next i
 
 
Dim as Integer MouseX, MouseY
 
Dim as single vminX, vminZ, vmaxX, vmaxZ
 
Dim switchcam as integer
 
 
Do
 
    getmouse MouseX, MouseY
 
    
 
    If switchcam=0 then
 
        vminX=MouseX-100 : if vminX<0 then vminX=0
 
        vminZ=MouseY-100 : if vminZ<0 then vminZ=0
 
    
 
        vmaxX=MouseX+100 : if vmaxX>799 then vmaxX=799
 
        vmaxZ=MouseY+100 : if vmaxZ>599 then vmaxZ=599
 
    else
 
        vminX=0 : vmaxX=800
 
        vminZ=0 : vmaxZ=600
 
    end if
 
    
 
    
 
    If multikey(&h3B) Then
 
        if switchcam=0 then 
 
            switchcam=1
 
        Else
 
            switchcam=0
 
        end if
 
        while multikey(&h3B):wend
 
    end if
 
    
 
    
 
    screenlock
 
        cls
 
        MyTree -> Draw(vminX,vminZ,vmaxX,vmaxZ)
 
        line (vminX,vminZ) - (vmaxX, vmaxZ), &hFF333333, B
 
    screenunlock
 
    
 
    sleep 1    
 
Loop until multikey(&h01)
 
 
 
sleep
 
 | 	 
  _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 20.05.2012, 19:43    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				Quadtree die Dritte  
 
 
Objecte in jeden Node zu speichern den es schneidet scheint mir tatsächlich sinnvoll, jedenfalls was die bisherigen Probleme angeht sieht es nun ganz gut aus, aber ich glaube immernoch das einiges nun genau deswegen mehrfach gezeichnet wird...
 
 
 	  | Code: | 	 		  
 
Sub CMsg (byval Msg as String)
 
    Dim FF as integer
 
    FF = FreeFile
 
    Open CONS for Output as #FF
 
    print #FF, Msg
 
    Close #FF
 
End Sub
 
 
 
Const MaxQuadDepth as Integer = 6
 
Type vec2
 
    X as single
 
    Z as single
 
End Type
 
 
Type testobj 
 
    min as vec2
 
    max as vec2
 
    col as integer
 
End Type
 
 
 
''Quelle: http://www.back-side.net/codingrects.html
 
Function QuadIntersection(Q1Start as vec2, Q1Len as vec2, Q2Start as vec2, Q2Len as vec2) As Integer
 
    Dim as Integer xl, zo, xr, zu 'Eckpunkte des umschriebenen Rechtecks: (xl,yo)-(xr-1,yu-1)
 
 
    'Bestimmen der Eckpunktkoordinaten
 
    xl = Q1Start.X           'links
 
    zo = Q1Start.Z           'oben
 
    xr = Q2Start.X + Q2Len.X 'rechts + 1
 
    zu = Q2Start.Z + Q2Len.Z 'unten  + 1
 
    
 
    If Q2Start.X < Q1Start.X Then xl = Q2Start.X
 
    If Q2Start.Z < Q1Start.Z Then zo = Q2Start.Z
 
    
 
    If (Q1Start.X + Q1Len.X) > (Q2Start.X + Q2Len.X) Then xr = Q1Start.X + Q1Len.X
 
    If (Q1Start.Z + Q1Len.Z) > (Q2Start.Z + Q2Len.Z) Then zu = Q1Start.Z + Q1Len.Z
 
 
    'Prüfen auf Kollision
 
    If ((Q1Len.X + Q2Len.X) > (xr - xl)) And ((Q1Len.Z + Q2Len.Z) > (zu - zo)) Then Return 1
 
    Return 0
 
End Function 
 
 
''Quadtree
 
Type Quadtree
 
    Declare Constructor()
 
    Declare Constructor(lo as vec2, hi as vec2, QuadDepth as Integer = 0)
 
    
 
    Bound_lo      as vec2
 
    Bound_hi      as vec2
 
    Center        as vec2
 
    
 
    IsSplit       as Integer
 
    Declare Function Split() as Integer
 
    
 
    QuadDepth     as Integer
 
    Nodes(0 to 3) as Quadtree ptr
 
    
 
    Declare Function AddObject(objdata as testobj ptr) as integer
 
    
 
    Objects_Count as Integer
 
    Objects_Data  as testobj ptr ptr
 
    
 
    Declare Function Draw(min as vec2, max as vec2) as Integer
 
End Type
 
 
Constructor Quadtree()
 
    this.Bound_lo      = type(0,0)
 
    this.Bound_hi      = type(0,0)
 
    this.Center        = type(0,0)
 
    this.QuadDepth     = 0
 
    this.Objects_Count = 0
 
    this.IsSplit       = 0
 
End Constructor
 
    
 
Constructor Quadtree(lo as vec2, hi as vec2, QuadDepth as Integer = 0)
 
    this.Bound_lo      = lo
 
    this.Bound_hi      = hi
 
    ''2D test!
 
        this.Center    = Type( lo.X + ((hi.X - lo.X) / 2), lo.Z + ((hi.Z - lo.Z) / 2) )
 
    ''3D
 
        'this.Center.X = 
 
        'this.Center.Z = 
 
    this.QuadDepth     = QuadDepth
 
    this.Objects_Count = 0
 
    this.IsSplit       = 0
 
End Constructor
 
 
Function Quadtree.Split() as Integer
 
    If (this.IsSplit = 1) or (this.QuadDepth = MaxQuadDepth) Then Return 0
 
    
 
    'Upper Left
 
    this.Nodes(0)  = NEW Quadtree
 
    *this.Nodes(0) = Type<Quadtree>( type<vec2>(this.Bound_lo.X, this.Bound_lo.Z), type<vec2>(this.Center.X, this.Center.Z)    , this.QuadDepth+1)
 
 
    'Upper Right
 
    this.Nodes(1)  = NEW Quadtree
 
    *this.Nodes(1) = Type<Quadtree>( type<vec2>(this.Center.X, this.Bound_lo.Z)  , type<vec2>(this.Bound_hi.X, this.Center.Z)  , this.QuadDepth+1)
 
 
    'Bottom Left
 
    this.Nodes(2)  = NEW Quadtree
 
    *this.Nodes(2) = Type<Quadtree>( type<vec2>(this.Bound_lo.X, this.Center.Z)  , type<vec2>(this.Center.X, this.Bound_hi.Z)  , this.QuadDepth+1)
 
 
    'Bottom Right
 
    this.Nodes(3)  = NEW Quadtree
 
    *this.Nodes(3) = Type<Quadtree>( type<vec2>(this.Center.X, this.Center.Z)    , type<vec2>(this.Bound_hi.X, this.Bound_hi.Z), this.QuadDepth+1)
 
  
 
    this.IsSplit = 1
 
    CMsg "Splitted :"+str(QuadDepth+1)
 
    Return 1
 
End Function
 
 
Function Quadtree.AddObject(objdata as testobj ptr) as Integer
 
    
 
    Dim QuadLen as vec2
 
    Dim ObjLen  as vec2
 
    QuadLen = type<vec2>(this.Bound_hi.X - this.Bound_lo.X , this.Bound_hi.Z - this.Bound_lo.Z)
 
    ObjLen  = type<vec2>((objdata -> max.X) - (objdata -> min.X) , (objdata -> max.Z) - (objdata -> min.Z))
 
    
 
    Dim Temp as any ptr
 
    
 
    If QuadIntersection(this.Bound_lo, QuadLen, (objdata -> min), ObjLen) = 1 Then
 
        Temp = reallocate(this.Objects_Data, (this.Objects_Count+1)*4)
 
        this.Objects_Data=Temp
 
        this.Objects_Data[this.Objects_Count] = objdata
 
        this.Objects_Count += 1
 
        
 
        If this.IsSplit=1 or this.Split()=1 then
 
            this.Nodes(0) -> AddObject(objdata)
 
            this.Nodes(1) -> AddObject(objdata)
 
            this.Nodes(2) -> AddObject(objdata)
 
            this.Nodes(3) -> AddObject(objdata)
 
        End If
 
        
 
        CMsg "Object Stored"
 
    End If
 
    
 
    return 0
 
End Function
 
 
Function Quadtree.Draw(min as vec2, max as vec2) as integer
 
    If this.Bound_lo.X>min.X and this.Bound_lo.Z>min.Z and this.Bound_hi.X<max.X and this.Bound_hi.Z<max.Z and this.Objects_Count>0 Then
 
        
 
        for i as integer=0 to this.Objects_Count-1
 
            line (this.Objects_Data[i] -> min.X, this.Objects_Data[i] -> min.Z) - _
 
                 (this.Objects_Data[i] -> max.X, this.Objects_Data[i] -> max.Z), this.Objects_Data[i] -> col, BF
 
        next i
 
        
 
        'debugline
 
        line (this.Bound_lo.X,this.Bound_lo.Z)-(this.Bound_hi.X,this.Bound_hi.Z),&hFF999999, B
 
    End If         
 
    
 
        If this.IsSplit = 1 Then
 
            this.Nodes(0) -> Draw(min,max)
 
            this.Nodes(1) -> Draw(min,max)
 
            this.Nodes(2) -> Draw(min,max)
 
            this.Nodes(3) -> Draw(min,max)
 
        End If
 
    
 
    Return 0
 
End Function    
 
'---------------------'
 
'test Quadtree
 
 
Randomize Timer
 
screen 19,32
 
 
Dim MyTree as Quadtree ptr = new Quadtree
 
*MyTree = type<Quadtree>(type<vec2>(0,0),type<vec2>(800,600))
 
 
Dim TestOBJ as testobj ptr ptr 
 
TestOBJ = callocate(100*4)
 
 
Dim as Integer rndStartX, rndStartZ, rndSize, rndColor
 
 
for i as integer=0 to 99
 
    rndStartX = rnd * 800
 
    rndStartZ = rnd * 600
 
    rndSize   = rnd * 150
 
    rndColor  = rnd * &hFFFFFF
 
         
 
    TestOBJ[i] = new testobj
 
    TestOBJ[i] -> min = type<vec2>(rndStartX,rndStartZ)
 
    TestOBJ[i] -> max = type<vec2>(rndStartX + rndSize, rndStartZ + rndSize)
 
    TestOBJ[i] -> col  = rndColor
 
    
 
    MyTree -> AddObject(TestOBJ[i])
 
next i
 
CMsg "Done"
 
 
Dim as Integer MouseX, MouseY
 
Dim as single vminX, vminZ, vmaxX, vmaxZ
 
Dim switchcam as integer
 
 
Do
 
    getmouse MouseX, MouseY
 
    
 
    If switchcam=0 then
 
        vminX=MouseX-100 : if vminX<0 then vminX=0
 
        vminZ=MouseY-100 : if vminZ<0 then vminZ=0
 
    
 
        vmaxX=MouseX+100 : if vmaxX>799 then vmaxX=799
 
        vmaxZ=MouseY+100 : if vmaxZ>599 then vmaxZ=599
 
    else
 
        vminX=0 : vmaxX=800
 
        vminZ=0 : vmaxZ=600
 
    end if
 
    
 
    
 
    If multikey(&h3B) Then
 
        if switchcam=0 then 
 
            switchcam=1
 
        Else
 
            switchcam=0
 
        end if
 
        while multikey(&h3B):wend
 
    end if
 
    
 
    
 
    screenlock
 
        cls
 
        MyTree -> Draw(type<vec2>(vminX,vminZ),type<vec2>(vmaxX,vmaxZ))
 
        line (vminX,vminZ) - (vmaxX, vmaxZ), &hFF333333, B
 
    screenunlock
 
    
 
    sleep 1    
 
Loop until multikey(&h01)
 
 | 	  
 
 
Edit: glaube aber eine Lösung dafür zu haben, wenn ich jeden hinzugefügten Objekt eine ID verpasse und vor dem Zeichnen Prüfe ob dieses nicht bereits gezeichnet wurde... mal sehen ob das so geht wie ich mir das vorstelle... _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 20.05.2012, 23:20    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				Sorry für den Doppelpost
 
 
Ich schätze ich hab den eigentlich Sinn eines Quadtrees inzwischen ziemlich verunstaltet, da ich objekte nun nur noch auf der tiefsten schnittebende Speicher, dann aber bei grossen Objekten immernoch auf mehreren...
 
 
 
 
 
In Diesem Image kann man meine imaginäre Kamera am grossen Rahmen erkennen, das Objekt hier Grün wird mir in all den 6 Nodes das es schneidet auch 6 mal gezeichnet.
 
 
Die Idee mit einer ID hab ich leider nicht hinbekommen.
 
 
Wie kann ich das verhindern das er mir das gleiche Objekt mehrfach zeichnet?!
 
 
Das ganze würde wenn das Grüne viereck bspw. ein Haus oder dergleichen im 3D Raum wär etwas blöd werden
 
 
In den meisten Quadtree beispielen und tutorials soll man dann die objekte entlang der schnittlinie 'teilen/trennen' das allerdings würde ich sehr gern vermeiden... mit den vierecken wär das ja noch leicht machbar, aber wenn dieses dann ein 3D objekt sein soll wird es doch etwas komplizierter.. zumal ich vorhabe die objekte per VBO sich selbst rendern zu lassen... _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		ThePuppetMaster
 
  
  Anmeldungsdatum: 18.02.2007 Beiträge: 1839 Wohnort: [JN58JR]
  | 
		 | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		XOR
 
 
  Anmeldungsdatum: 23.07.2010 Beiträge: 161
 
  | 
		
			
				 Verfasst am: 21.05.2012, 14:56    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				aufgefallen ist mir:
 
1) man sollte ein node erst dann teilen, wenn die anzahl der objekte in ihm eine bestimmte anzahl übersteigen.
 
2) ist ein node geteilt, muss es nicht mehr die objekte speichern, da das die untergeordneten nods machen.
 
3) ist ein node nicht im sichtbaren bereich, sind das die untergeordneten nodes auch nicht.
 
4) ist ein objekt bei deinem programm nur zum teil in einem node, so wird es nicht gezeichnet, wenn das node aber sichtbar ist.
 
5) keine speicherbereinigung!
 
 
die punkte habe ich verbessert:
 
 	  | Code: | 	 		  Sub CMsg (ByVal Msg As String)
 
   Dim FF as integer
 
   FF = FreeFile
 
   Open CONS for Output as #FF
 
   print #FF, Msg
 
   Close #FF
 
End Sub
 
 
 
Const MaxQuadDepth As Integer = 8
 
Const NumberOfObjects As Integer = 1000
 
Const SplitWhenMoreThan As Integer = 3
 
 
Type vec2
 
   X As Single
 
   Z As Single
 
End Type
 
 
Type testobj
 
   min As vec2
 
   max As vec2
 
   col As Integer
 
   isDrawn As Integer
 
End Type
 
 
 
''Quelle: http://www.back-side.net/codingrects.html
 
Function QuadIntersection(Q1Start As vec2, Q1Len As vec2, Q2Start As vec2, Q2Len As vec2) As Integer
 
   Dim As Integer xl, zo, xr, zu 'Eckpunkte des umschriebenen Rechtecks: (xl,yo)-(xr-1,yu-1)
 
 
   'Bestimmen der Eckpunktkoordinaten
 
   xl = Q1Start.X           'links
 
   zo = Q1Start.Z           'oben
 
   xr = Q2Start.X + Q2Len.X 'rechts + 1
 
   zu = Q2Start.Z + Q2Len.Z 'unten  + 1
 
 
   If Q2Start.X < Q1Start.X Then xl = Q2Start.X
 
   If Q2Start.Z < Q1Start.Z Then zo = Q2Start.Z
 
 
   If (Q1Start.X + Q1Len.X) > (Q2Start.X + Q2Len.X) Then xr = Q1Start.X + Q1Len.X
 
   If (Q1Start.Z + Q1Len.Z) > (Q2Start.Z + Q2Len.Z) Then zu = Q1Start.Z + Q1Len.Z
 
 
   'Prüfen auf Kollision
 
   If ((Q1Len.X + Q2Len.X) > (xr - xl)) And ((Q1Len.Z + Q2Len.Z) > (zu - zo)) Then Return 1
 
   Return 0
 
End Function
 
 
''Quadtree
 
Type Quadtree
 
   Declare Constructor()
 
   Declare Constructor(lo As vec2, hi As vec2, QuadDepth As Integer = 0)
 
   Declare Destructor()
 
 
   Bound_lo      As vec2
 
   Bound_hi      As vec2
 
   Center        As vec2
 
 
   IsSplit       As Integer
 
   Declare Function Split() As Integer
 
 
   QuadDepth     As Integer
 
   Nodes(0 To 3) As Quadtree Ptr
 
 
   Declare Function AddObject(objdata As testobj Ptr) As Integer
 
 
   Objects_Count As Integer
 
   Objects_Data  As testobj Ptr Ptr
 
 
   Declare Function Draw(min As vec2, max As vec2) As Integer
 
End Type
 
 
Constructor Quadtree()
 
   this.Bound_lo      = Type(0,0)
 
   this.Bound_hi      = Type(0,0)
 
   this.Center        = Type(0,0)
 
   this.QuadDepth     = 0
 
   this.Objects_Count = 0
 
   this.IsSplit       = 0
 
End Constructor
 
 
Constructor Quadtree(lo As vec2, hi As vec2, QuadDepth As Integer = 0)
 
   this.Bound_lo      = lo
 
   this.Bound_hi      = hi
 
   ''2D test!
 
   this.Center    = Type( lo.X + ((hi.X - lo.X) / 2), lo.Z + ((hi.Z - lo.Z) / 2) )
 
   ''3D
 
   'this.Center.X =
 
   'this.Center.Z =
 
   this.QuadDepth     = QuadDepth
 
   this.Objects_Count = 0
 
   this.IsSplit       = 0
 
End Constructor
 
 
Destructor Quadtree()
 
   If(This.IsSplit)Then
 
      Delete This.Nodes(0)
 
      Delete This.Nodes(1)
 
      Delete This.Nodes(2)
 
      Delete This.Nodes(3)
 
   EndIf
 
   If(This.Objects_Data)Then DeAllocate(This.Objects_Data)
 
End Destructor
 
 
Function Quadtree.Split() As Integer
 
   If (this.IsSplit = 1) Or (this.QuadDepth = MaxQuadDepth) Then Return 0
 
 
   'Upper Left
 
   this.Nodes(0)  = New Quadtree( Type<vec2>(this.Bound_lo.X, this.Bound_lo.Z), Type<vec2>(this.Center.X, this.Center.Z)    , this.QuadDepth+1)
 
   '*this.Nodes(0) = Type<Quadtree>( Type<vec2>(this.Bound_lo.X, this.Bound_lo.Z), Type<vec2>(this.Center.X, this.Center.Z)    , this.QuadDepth+1)
 
 
   'Upper Right
 
   this.Nodes(1)  = New Quadtree( Type<vec2>(this.Center.X, this.Bound_lo.Z)  , Type<vec2>(this.Bound_hi.X, this.Center.Z)  , this.QuadDepth+1)
 
   '*this.Nodes(1) = Type<Quadtree>( Type<vec2>(this.Center.X, this.Bound_lo.Z)  , Type<vec2>(this.Bound_hi.X, this.Center.Z)  , this.QuadDepth+1)
 
 
   'Bottom Left
 
   this.Nodes(2)  = New Quadtree( Type<vec2>(this.Bound_lo.X, this.Center.Z)  , Type<vec2>(this.Center.X, this.Bound_hi.Z)  , this.QuadDepth+1)
 
   '*this.Nodes(2) = Type<Quadtree>( Type<vec2>(this.Bound_lo.X, this.Center.Z)  , Type<vec2>(this.Center.X, this.Bound_hi.Z)  , this.QuadDepth+1)
 
 
   'Bottom Right
 
   this.Nodes(3)  = New Quadtree( Type<vec2>(this.Center.X, this.Center.Z)    , Type<vec2>(this.Bound_hi.X, this.Bound_hi.Z), this.QuadDepth+1)
 
   '*this.Nodes(3) = Type<Quadtree>( Type<vec2>(this.Center.X, this.Center.Z)    , Type<vec2>(this.Bound_hi.X, this.Bound_hi.Z), this.QuadDepth+1)
 
 
   this.IsSplit = 1
 
   CMsg "Splitted :"+Str(QuadDepth+1)
 
   Return 1
 
End Function
 
 
Function Quadtree.AddObject(objdata As testobj Ptr) As Integer
 
   Dim QuadLen As vec2
 
   Dim ObjLen  As vec2
 
   QuadLen = Type<vec2>(this.Bound_hi.X - this.Bound_lo.X , this.Bound_hi.Z - this.Bound_lo.Z)
 
   ObjLen  = Type<vec2>((objdata -> max.X) - (objdata -> min.X) , (objdata -> max.Z) - (objdata -> min.Z))
 
 
   Dim Temp As Any Ptr
 
 
   If QuadIntersection(this.Bound_lo, QuadLen, (objdata -> min), ObjLen) = 1 Then
 
      If(this.IsSplit=1)Then
 
         this.Nodes(0) -> AddObject(objdata)
 
         this.Nodes(1) -> AddObject(objdata)
 
         this.Nodes(2) -> AddObject(objdata)
 
         this.Nodes(3) -> AddObject(objdata)
 
      Else
 
         If(this.Objects_Count >= SplitWhenMoreThan)Then
 
            If(this.Split())Then
 
               For i As Integer = 0 To this.Objects_Count-1
 
                  this.Nodes(0) -> AddObject(This.Objects_Data[i])
 
                  this.Nodes(1) -> AddObject(This.Objects_Data[i])
 
                  this.Nodes(2) -> AddObject(This.Objects_Data[i])
 
                  this.Nodes(3) -> AddObject(This.Objects_Data[i])
 
               Next i
 
               this.Objects_Count = 0
 
               If(This.Objects_Data)Then DeAllocate(This.Objects_Data)
 
               This.Objects_Data = 0
 
               this.Nodes(0) -> AddObject(objdata)
 
               this.Nodes(1) -> AddObject(objdata)
 
               this.Nodes(2) -> AddObject(objdata)
 
               this.Nodes(3) -> AddObject(objdata)
 
            Else
 
               this.Objects_Data = ReAllocate(this.Objects_Data, (this.Objects_Count+1)*4)
 
               this.Objects_Data[this.Objects_Count] = objdata
 
               this.Objects_Count += 1
 
               CMsg "Object Stored"
 
            EndIf
 
         Else
 
            this.Objects_Data = ReAllocate(this.Objects_Data, (this.Objects_Count+1)*4)
 
            this.Objects_Data[this.Objects_Count] = objdata
 
            this.Objects_Count += 1
 
            CMsg "Object Stored"
 
         EndIf
 
      EndIf
 
   EndIf
 
 
   Return 0
 
End Function
 
 
Function Quadtree.Draw(min As vec2, max As vec2) As Integer
 
   Dim QuadLen As vec2
 
   Dim ObjLen  As vec2
 
   QuadLen = Type<vec2>(this.Bound_hi.X - this.Bound_lo.X , this.Bound_hi.Z - this.Bound_lo.Z)
 
   ObjLen  = Type<vec2>((max.X) - (min.X) , (max.Z) - (min.Z))
 
 
   If QuadIntersection(this.Bound_lo, QuadLen, min, ObjLen) Then
 
      If this.IsSplit = 1 Then
 
         this.Nodes(0) -> Draw(min,max)
 
         this.Nodes(1) -> Draw(min,max)
 
         this.Nodes(2) -> Draw(min,max)
 
         this.Nodes(3) -> Draw(min,max)
 
      Else
 
         For i As Integer=0 To this.Objects_Count-1
 
            If(this.Objects_Data[i]->isDrawn = 0)Then
 
               Line (this.Objects_Data[i] -> min.X, this.Objects_Data[i] -> min.Z) - _
 
               (this.Objects_Data[i] -> max.X, this.Objects_Data[i] -> max.Z), this.Objects_Data[i] -> col, BF
 
               this.Objects_Data[i]->isDrawn = 1
 
            EndIf
 
         Next i
 
         'debugline
 
         Line (this.Bound_lo.X,this.Bound_lo.Z)-(this.Bound_hi.X,this.Bound_hi.Z),&hFF999999, B
 
      EndIf
 
   End If
 
 
   Return 0
 
End Function
 
'---------------------'
 
'test Quadtree
 
 
Randomize Timer
 
Screen 19,32
 
 
Dim MyTree As Quadtree Ptr = New Quadtree(Type<vec2>(0,0),Type<vec2>(800,600))
 
'*MyTree = Type<Quadtree>(Type<vec2>(0,0),Type<vec2>(800,600))
 
 
Dim TestOBJ As testobj Ptr Ptr
 
TestOBJ = Callocate(NumberOfObjects*4)
 
 
Dim As Integer rndStartX, rndStartZ, rndSize, rndColor
 
 
For i As Integer=0 To NumberOfObjects-1
 
   CMsg "Add Object"+Str(i)
 
   
 
   rndStartX = Rnd * 799
 
   rndStartZ = Rnd * 599
 
   rndSize   = Rnd * 25 + 5
 
   rndColor  = Rnd * &hFFFFFF
 
 
   TestOBJ[i] = New testobj
 
   TestOBJ[i] -> min = Type<vec2>(rndStartX,rndStartZ)
 
   TestOBJ[i] -> max = Type<vec2>(rndStartX + rndSize, rndStartZ + rndSize)
 
   TestOBJ[i] -> col  = rndColor
 
   TestOBJ[i] -> isDrawn = 0
 
 
   MyTree -> AddObject(TestOBJ[i])
 
Next i
 
CMsg "Done"
 
 
Dim As Integer MouseX, MouseY
 
Dim As Single vminX, vminZ, vmaxX, vmaxZ
 
Dim switchcam As Integer
 
Dim As Integer numDrawnObjects
 
 
Do
 
   GetMouse MouseX, MouseY
 
 
   If switchcam=0 Then
 
      vminX=MouseX-100 : If vminX<0 Then vminX=0
 
      vminZ=MouseY-100 : If vminZ<0 Then vminZ=0
 
 
      vmaxX=MouseX+100 : If vmaxX>799 Then vmaxX=799
 
      vmaxZ=MouseY+100 : If vmaxZ>599 Then vmaxZ=599
 
   Else
 
      vminX=0 : vmaxX=800
 
      vminZ=0 : vmaxZ=600
 
   End If
 
 
 
   If MultiKey(&h3B) Then
 
      If switchcam=0 Then
 
         switchcam=1
 
      Else
 
         switchcam=0
 
      End If
 
      While MultiKey(&h3B):Wend
 
   End If
 
 
 
   ScreenLock
 
   Cls
 
   MyTree -> Draw(Type<vec2>(vminX,vminZ),Type<vec2>(vmaxX,vmaxZ))
 
   Line (vminX,vminZ) - (vmaxX, vmaxZ), &hFF333333, B
 
   Locate 1,1
 
   Print numDrawnObjects
 
   ScreenUnLock
 
 
   numDrawnObjects = 0
 
   For i As Integer = 0 To NumberOfObjects-1
 
      If(TestOBJ[i] -> isDrawn = 1)Then
 
         numDrawnObjects+=1
 
      EndIf
 
      TestOBJ[i] -> isDrawn = 0
 
   Next
 
 
   Sleep 1
 
Loop Until MultiKey(&h01)
 
 
Delete MyTree
 
For i As Integer=0 To NumberOfObjects-1
 
   Delete TestOBJ[i]
 
Next i
 
DeAllocate(TestOBJ) | 	  
 
und das doppelt zeichnen habe ich auch mit der gleichen methode wie ThePuppetMaster behoben. | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 21.05.2012, 18:35    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				 	  | Zitat: | 	 		  
 
1) man sollte ein node erst dann teilen, wenn die anzahl der objekte in ihm eine bestimmte anzahl übersteigen.
 
2) ist ein node geteilt, muss es nicht mehr die objekte speichern, da das die untergeordneten nods machen. 
 
 | 	  
 
 
Die Punkte entziehen sich meinem Verständnis ein bisschen...
 
 
Als zusatz hab ich noch gelesen das man keine Objekte im obersten Node der ja quasi die gesamte Welt/Bildschirm darstellt speichern...
 
Also muss ich ja immerhin EINMAL teilen bevor ich zu speichern anfange...
 
Warum sollte ich allerdings nun ein sehr kleines Objekt in ein sehr grosses Node speichern?!
 
 
Wenn ich nun dennoch punkt 1 und 2 berücksichtige, eleminiere ich nicht eigentlich einen mehrfachverweis von objekten?!
 
darf mir dann aber auch keine teilgrenze setzen und so lange teilen wie noch objekte 'eingelagert' werden?!?!
 
 
 	  | Zitat: | 	 		  
 
3) ist ein node nicht im sichtbaren bereich, sind das die untergeordneten nodes auch nicht. 
 
 | 	  
 
 
Der punkt ist mir klar, hab mir mein eigenes Beispiel oben nicht mehr so genau angesehen, machte er bei meinen neuen Versuchen allerdings auch nicht
 
 
Mein Problem war noch, das ich probehalber aber gezeichnet habe wenn das node auch nur teilweise sichtbar war, was mir aber fatal schien
 
wenn ich zB auf die schnittpunkte in der mitte der ersten teilung bin, wurde mir da quasi fast die gesamte Welt gezeichnet...
 
Somit hab ich bei einem neuen Versuch eben Objekte in allen Nodes gespeichert die es schneidet anschliessend aber nur nodes gezeichnet die GANZ im sichtbereich sind,
 
was bei den oberen Nodes aber nie der fall sein würde, weshalb eben beim einlagern bis zur maximalen tiefe geteilt wird und in jedes entstandende Node das vom
 
Objekt geschnitten wurde auch den Verweis zum Objekt angegeben habe (was dann aber eben zu der unangenehmen mehrfachzeichung kam)
 
bzw. in meinem letzten versuch habe ich alle objekte ins lezte node verwiesen wärend aber die oberen nodes leer sind
 
 
was mich schon zu der Frage bewegt hat ob eine art Gitter Container nicht vielleicht die sinnvollere Wahl wäre...
 
 
 	  | Zitat: | 	 		  
 
4) ist ein objekt bei deinem programm nur zum teil in einem node, so wird es nicht gezeichnet, wenn das node aber sichtbar ist. 
 
 | 	  
 
 
Sollte in meinem letzten Versuch eigentlich behoben sein.. alle GANZ sichtbaren Nodes zeichnet alle in sich enthaltenen Objekte...
 
 
 	  | Zitat: | 	 		  
 
5) keine speicherbereinigung! 
 
 | 	  
 
Ich weiss, wollte ich hinzufügen wenn das ganze 'einsatzfähig' ist  
 
 
 	  | Zitat: | 	 		  
 
und das doppelt zeichnen habe ich auch mit der gleichen methode wie ThePuppetMaster behoben.
 
 | 	  
 
 
Der Ansatz ansich gefällt mir sehr gut, löst in diesem Beispiel auch das Problem ist jedoch nicht sehr praktisch...
 
 
Hier im beispiel hab ich einfach ein paar zufalls objekte in einem grossen Pointer gestopft, das eigentlich ziel aber sollte später sein
 
das ich es ganz anders mache: zB so (Pseudo code)
 
 	  | Code: | 	 		  
 
Dim Welt as Quadtree
 
 
Dim Haus as 3DObjekt
 
Haus=Lade3DObjekt("Haus.3d")
 
 
Welt.Add(Haus,x,y,z)
 
 
Welt.Draw()
 
 | 	  
 
 
So oder so ähnlich. Jedenfalls wäre es sinnvoll könnte man das irgendwie in der Quadtree.Draw Function mit einbinden,
 
das man auf sowas in der Hauptschleife nachher nicht mehr achten müsste...
 
 
 
Hier nochmal mein eigener letzter Versuch von gestern Abend:
 
 	  | Code: | 	 		  
 
Sub CMsg (byval Msg as String)
 
    Dim FF as integer
 
    FF = FreeFile
 
    Open CONS for Output as #FF
 
    print #FF, Msg
 
    Close #FF
 
End Sub
 
 
 
Const MaxQuadDepth as Integer = 5
 
Type vec2
 
    X as single
 
    Z as single
 
End Type
 
 
Type testobj 
 
    min as vec2
 
    max as vec2
 
    col as integer
 
    Declare Sub Draw()
 
End Type
 
 
Sub testobj.Draw()
 
    line (this.min.X, this.min.Z) - _
 
         (this.max.X, this.max.Z), this.col, BF
 
End Sub
 
 
 
 
''Quelle: http://www.back-side.net/codingrects.html
 
Function QuadIntersection(Q1Start as vec2, Q1Len as vec2, Q2Start as vec2, Q2Len as vec2) As Integer
 
    Dim as Integer xl, zo, xr, zu 'Eckpunkte des umschriebenen Rechtecks: (xl,yo)-(xr-1,yu-1)
 
 
    'Bestimmen der Eckpunktkoordinaten
 
    xl = Q1Start.X           'links
 
    zo = Q1Start.Z           'oben
 
    xr = Q2Start.X + Q2Len.X 'rechts + 1
 
    zu = Q2Start.Z + Q2Len.Z 'unten  + 1
 
    
 
    If Q2Start.X < Q1Start.X Then xl = Q2Start.X
 
    If Q2Start.Z < Q1Start.Z Then zo = Q2Start.Z
 
    
 
    If (Q1Start.X + Q1Len.X) > (Q2Start.X + Q2Len.X) Then xr = Q1Start.X + Q1Len.X
 
    If (Q1Start.Z + Q1Len.Z) > (Q2Start.Z + Q2Len.Z) Then zu = Q1Start.Z + Q1Len.Z
 
 
    'Prüfen auf Kollision
 
    If ((Q1Len.X + Q2Len.X) > (xr - xl)) And ((Q1Len.Z + Q2Len.Z) > (zu - zo)) Then Return 1
 
    Return 0
 
End Function 
 
 
''Quadtree
 
Type Quadtree
 
    Declare Constructor()
 
    Declare Constructor(lo as vec2, hi as vec2, QuadDepth as Integer = 0)
 
    
 
    Bound_lo      as vec2
 
    Bound_hi      as vec2
 
    Center        as vec2
 
    
 
    IsSplit       as Integer
 
    Declare Function Split() as Integer
 
    
 
    QuadDepth     as Integer
 
    Nodes(0 to 3) as Quadtree ptr
 
    
 
    Declare Function AddObject(objdata as testobj ptr) as integer
 
    
 
    Objects_Count as Integer
 
    Objects_Data  as testobj ptr ptr
 
    
 
    Declare Function Draw(min as vec2, max as vec2) as Integer
 
End Type
 
 
Constructor Quadtree()
 
    this.Bound_lo      = type(0,0)
 
    this.Bound_hi      = type(0,0)
 
    this.Center        = type(0,0)
 
    this.QuadDepth     = 0
 
    this.Objects_Count = 0
 
    this.IsSplit       = 0
 
End Constructor
 
    
 
Constructor Quadtree(lo as vec2, hi as vec2, QuadDepth as Integer = 0)
 
    this.Bound_lo      = lo
 
    this.Bound_hi      = hi
 
    ''2D test!
 
        this.Center    = Type( lo.X + ((hi.X - lo.X) / 2), lo.Z + ((hi.Z - lo.Z) / 2) )
 
    ''3D
 
        'this.Center.X = 
 
        'this.Center.Z = 
 
    this.QuadDepth     = QuadDepth
 
    this.Objects_Count = 0
 
    this.IsSplit       = 0
 
End Constructor
 
 
Function Quadtree.Split() as Integer
 
    If (this.IsSplit = 1) or (this.QuadDepth = MaxQuadDepth) Then Return 0
 
    
 
    'Upper Left
 
    this.Nodes(0)  = NEW Quadtree
 
    *this.Nodes(0) = Type<Quadtree>( type<vec2>(this.Bound_lo.X, this.Bound_lo.Z), type<vec2>(this.Center.X, this.Center.Z)    , this.QuadDepth+1)
 
 
    'Upper Right
 
    this.Nodes(1)  = NEW Quadtree
 
    *this.Nodes(1) = Type<Quadtree>( type<vec2>(this.Center.X, this.Bound_lo.Z)  , type<vec2>(this.Bound_hi.X, this.Center.Z)  , this.QuadDepth+1)
 
 
    'Bottom Left
 
    this.Nodes(2)  = NEW Quadtree
 
    *this.Nodes(2) = Type<Quadtree>( type<vec2>(this.Bound_lo.X, this.Center.Z)  , type<vec2>(this.Center.X, this.Bound_hi.Z)  , this.QuadDepth+1)
 
 
    'Bottom Right
 
    this.Nodes(3)  = NEW Quadtree
 
    *this.Nodes(3) = Type<Quadtree>( type<vec2>(this.Center.X, this.Center.Z)    , type<vec2>(this.Bound_hi.X, this.Bound_hi.Z), this.QuadDepth+1)
 
  
 
    this.IsSplit = 1
 
    'CMsg "Splitted :"+str(QuadDepth+1)
 
    Return 1
 
End Function
 
 
Function Quadtree.AddObject(objdata as testobj ptr) as Integer
 
    
 
    Dim QuadLen(0 to 4) as vec2
 
    Dim ObjLen  as vec2
 
    QuadLen(0) = type<vec2>(this.Bound_hi.X - this.Bound_lo.X , this.Bound_hi.Z - this.Bound_lo.Z)
 
    ObjLen  = type<vec2>((objdata -> max.X) - (objdata -> min.X) , (objdata -> max.Z) - (objdata -> min.Z))
 
    
 
    Dim Temp as any ptr
 
    Dim NX as Integer
 
    
 
    If QuadIntersection(this.Bound_lo, QuadLen(0), (objdata -> min), ObjLen) = 1 Then
 
        If this.IsSplit=1 or this.Split()=1 then
 
            
 
            QuadLen(1) = type<vec2>( (this.Nodes(0) -> Bound_hi.X) - (this.Nodes(0) -> Bound_lo.X) , (this.Nodes(0) -> Bound_hi.Z) - (this.Nodes(0) -> Bound_lo.Z) )
 
            QuadLen(2) = type<vec2>( (this.Nodes(1) -> Bound_hi.X) - (this.Nodes(1) -> Bound_lo.X) , (this.Nodes(1) -> Bound_hi.Z) - (this.Nodes(1) -> Bound_lo.Z) )
 
            QuadLen(3) = type<vec2>( (this.Nodes(2) -> Bound_hi.X) - (this.Nodes(2) -> Bound_lo.X) , (this.Nodes(2) -> Bound_hi.Z) - (this.Nodes(2) -> Bound_lo.Z) )
 
            QuadLen(4) = type<vec2>( (this.Nodes(3) -> Bound_hi.X) - (this.Nodes(3) -> Bound_lo.X) , (this.Nodes(3) -> Bound_hi.Z) - (this.Nodes(3) -> Bound_lo.Z) )
 
 
            If QuadIntersection(this.Nodes(0) -> Bound_lo, QuadLen(1), (objdata -> min), ObjLen) = 1 Then NX+=&b1000
 
            If QuadIntersection(this.Nodes(1) -> Bound_lo, QuadLen(2), (objdata -> min), ObjLen) = 1 Then NX+=&b0100
 
            If QuadIntersection(this.Nodes(2) -> Bound_lo, QuadLen(3), (objdata -> min), ObjLen) = 1 Then NX+=&b0010
 
            If QuadIntersection(this.Nodes(3) -> Bound_lo, QuadLen(4), (objdata -> min), ObjLen) = 1 Then NX+=&b0001
 
            
 
            If NX>0 Then
 
                If (NX >= &b1000) Then this.Nodes(0) -> AddObject(objdata)
 
                If (NX >= &b0100) Then this.Nodes(1) -> AddObject(objdata) 
 
                If (NX >= &b0010) Then this.Nodes(2) -> AddObject(objdata)
 
                If (NX >= &b0001) Then this.Nodes(3) -> AddObject(objdata)
 
            End If
 
        Else
 
            Temp = reallocate(this.Objects_Data, (this.Objects_Count+1)*4)
 
            this.Objects_Data=Temp
 
            this.Objects_Data[this.Objects_Count] = objdata
 
            this.Objects_Count += 1
 
        End If
 
    End If
 
    
 
    return 0
 
End Function
 
 
Function Quadtree.Draw(min as vec2, max as vec2) as integer
 
    If this.Bound_lo.X>min.X and this.Bound_lo.Z>min.Z and this.Bound_hi.X<max.X and this.Bound_hi.Z<max.Z and this.Objects_Count>0 Then
 
        
 
        for i as integer=0 to this.Objects_Count-1
 
            this.Objects_Data[i] -> Draw()
 
            'line (this.Objects_Data[i] -> min.X, this.Objects_Data[i] -> min.Z) - _
 
            '     (this.Objects_Data[i] -> max.X, this.Objects_Data[i] -> max.Z), this.Objects_Data[i] -> col, BF
 
        next i
 
        
 
        'debugline
 
        line (this.Bound_lo.X,this.Bound_lo.Z)-(this.Bound_hi.X,this.Bound_hi.Z),&hFF999999, B
 
    End If                 
 
    
 
    If this.IsSplit = 1 Then
 
        this.Nodes(0) -> Draw(min,max)
 
        this.Nodes(1) -> Draw(min,max)
 
        this.Nodes(2) -> Draw(min,max)
 
        this.Nodes(3) -> Draw(min,max)
 
    End If
 
    
 
    Return 0
 
End Function    
 
'---------------------'
 
'test Quadtree
 
 
Randomize Timer
 
screen 19,32
 
 
Dim MyTree as Quadtree ptr = new Quadtree
 
*MyTree = type<Quadtree>(type<vec2>(0,0),type<vec2>(800,600))
 
 
Dim TOBJ as testobj ptr ptr 
 
TOBJ = callocate(1000*4)
 
 
Dim as Integer rndStartX, rndStartZ, rndSize, rndColor
 
 
for i as integer=0 to 9
 
    rndStartX = rnd * 800
 
    rndStartZ = rnd * 600
 
    rndSize   = rnd * 150
 
    rndColor  = rnd * &hFFFFFF
 
         
 
    TOBJ[i] = new testobj
 
    TOBJ[i] -> min = type<vec2>(rndStartX,rndStartZ)
 
    TOBJ[i] -> max = type<vec2>(rndStartX + rndSize, rndStartZ + rndSize)
 
    TOBJ[i] -> col  = rndColor
 
    
 
    MyTree -> AddObject(TOBJ[i])
 
next i
 
CMsg "Done"
 
 
Dim as Integer MouseX, MouseY
 
Dim as single vminX, vminZ, vmaxX, vmaxZ
 
Dim switchcam as integer
 
 
Do
 
    getmouse MouseX, MouseY
 
    
 
    If switchcam=0 then
 
        vminX=MouseX-100 : if vminX<0 then vminX=0
 
        vminZ=MouseY-100 : if vminZ<0 then vminZ=0
 
    
 
        vmaxX=MouseX+100 : if vmaxX>799 then vmaxX=799
 
        vmaxZ=MouseY+100 : if vmaxZ>599 then vmaxZ=599
 
    else
 
        vminX=0 : vmaxX=800
 
        vminZ=0 : vmaxZ=600
 
    end if
 
    
 
    
 
    If multikey(&h3B) Then
 
        if switchcam=0 then 
 
            switchcam=1
 
        Else
 
            switchcam=0
 
        end if
 
        while multikey(&h3B):wend
 
    end if
 
    
 
    
 
    screenlock
 
        cls
 
        MyTree -> Draw(type<vec2>(vminX,vminZ),type<vec2>(vmaxX,vmaxZ))
 
        line (vminX,vminZ) - (vmaxX, vmaxZ), &hFF333333, B
 
        'CMsg "-------------"
 
    screenunlock
 
    
 
    sleep 1
 
Loop until multikey(&h01)
 
 | 	 
  _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		ThePuppetMaster
 
  
  Anmeldungsdatum: 18.02.2007 Beiträge: 1839 Wohnort: [JN58JR]
  | 
		
			
				 Verfasst am: 21.05.2012, 19:50    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				das lässt sich durchaus auch im draw machen, wenn du darauf verzichtest, das Draw sich selbst rekrusiv aufruft. dan kannst du das "reset" nämlich im draw, nur für das obj. erledigen.
 
 
Das Rücksetzen wollte ich ursprünglich auch im draw machen, bis ich gesehen habe, wie du damit umgehst. .. wichtig ist einfach, das du dieses objekt nur 1x zurücksetzen, und nicht mehrfach und das ist eben obj. bezogen.
 
 
 
MfG
 
TPM _________________ [ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		XOR
 
 
  Anmeldungsdatum: 23.07.2010 Beiträge: 161
 
  | 
		
			
				 Verfasst am: 21.05.2012, 20:15    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				 	  | Zitat: | 	 		  
 
 	  | Zitat: | 	 		  1) man sollte ein node erst dann teilen, wenn die anzahl der objekte in ihm eine bestimmte anzahl übersteigen.
 
2) ist ein node geteilt, muss es nicht mehr die objekte speichern, da das die untergeordneten nods machen. | 	  
 
 
Die Punkte entziehen sich meinem Verständnis ein bisschen...  | 	  
 
 
Aufgabe des Quad- oder Octree ist es, die objekte, die nicht im sichtbereich sind, herauszufiltern. da es bei sehr vielen objekten lange braucht zu schauen ob jedes im sichtbereich liegt, benutzt man Quad- oder Octrees.
 
Wenn man nun die objekte in der baumstruktur hat, kann man schauen ob ein node sichtbar ist. ist das nicht der fall, sind die childs auch nicht sichtbar und es muss auch nicht geprüft werden. ist das node sichtbar, muss man auch bei den childes schauen ob sie sichtbar sind. wenn jetzt aber in einem child 8ten grades oder tiefer nun ein sehr kleines Objekt liegt, muss man alle übergeordneten nodes auf sichtbarkeit kontrollieren und das nur wegen dem einen kleinen Objekt. wenn man dieses nun aber zusammen mit 100 anderen in einem child, das näher am stamm liegt speichert kann es sein, das es gezeichnet wird, ohne das es im sichtbereich ist, aber das ist schneller. und man benutzt die Quad- oder Octree um möglichst schnell alles zu zeichnen.
 
 
 	  | Zitat: | 	 		  | Der punkt ist mir klar, hab mir mein eigenes Beispiel oben nicht mehr so genau angesehen, machte er bei meinen neuen Versuchen allerdings auch nicht  | 	  
 
aber genau dadurch ist das ganze so schnell.
 
 
 	  | Zitat: | 	 		  | Sollte in meinem letzten Versuch eigentlich behoben sein.. alle GANZ sichtbaren Nodes zeichnet alle in sich enthaltenen Objekte...  | 	  
 
aber auch die nur zum teil sichtbaren Nodes müssen gezeichnet werden.
 
 
 	  | Zitat: | 	 		   	  | Zitat: | 	 		  | und das doppelt zeichnen habe ich auch mit der gleichen methode wie ThePuppetMaster behoben.  | 	  
 
Der Ansatz ansich gefällt mir sehr gut, löst in diesem Beispiel auch das Problem ist jedoch nicht sehr praktisch...  | 	  
 
folgende idee: jeden frame wird ein counter um 1 erhöt. wird das objekt gezeichnet, so wird dessen variable "last drawn" die zahl vom counter zugewiesen. bevor das objekt gezeichnet wird schaut man also ob dessen last drawn ungleich dem counter ist und zeichnet dann. | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 21.05.2012, 23:21    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				 	  | Zitat: | 	 		  | ist das node sichtbar, muss man auch bei den childes schauen ob sie sichtbar sind. | 	  
 
Eigentlich mein ich gelesen zu haben, ist ein Node sichtbar, braucht man die Child Nodes nicht mehr zu prüfen,
 
denn logischerweise sind die 'kleineren' blätter ja dann auch sichtbar...
 
Anders ist es nun in meinem neusten Versuch, da ich Nodes auf TEILWEISE sichtbar prüfe, muss ich dann auch die Childs prüfen
 
 
Hab das Beispiel diesmal ein bisschen besser Dokumentiert, 
 
Probleme stellen die schnittlinien dar...
 
 
In diesem Versuch speicher ich Objekte Ihrer Grösse nach, so kann es unter umständen sein das Objekte auch in der Wurzel gespeichert werden 
 
was ich als 'Sonderfall sehe' (in der Regel hab ich nicht vor so grosse objekte zu nutzen)
 
In Diesem besonderen Fall wird jedes in der Wurzel befindliche Objekt auf sichtbarkeit geprüft...
 
 
Und wie gesagt, die schnittlinien, da objekte sich darauf befinden können, heisst es sie passen nicht im unterliegenden Node und werden daher eine Ebene
 
höher gespeichert und somit gelegentlich unnötig mehr objekte gezeichnet als nötig wäre...
 
 
ABER (VORTEIL!) keine mehrfachverweise und damit das verbundene Problem von mehrfach zeichnungen...
 
 
Obwohl mir die letzte Idee von Dir gefällt, hätte nun jedem Frame eine zufalls ID gegeben
 
welche ich wiederrum der gezeichneten Objekte übergebe, hat Objekt(X) diese ID wäre es schon
 
gezeichnet und könnte übersprungen werden...
 
 
Werd den Ansatz evtl auch nochmal ausprobieren.
 
Dieser hier gefällt mir nun aber auch schon ganz gut
 
 
 	  | Code: | 	 		  
 
Randomize Timer
 
Const AnzahlObjekte as Integer = 1200
 
Const QuadMaxDepth as Integer = 16
 
 
 
'' Diese Klasse ist nur zu testzwecken
 
Type ObjectData
 
    'Hält die Eckpunkte (bounding box) des Objekts fest
 
    Min_X as Integer 
 
    Max_X as Integer
 
    Min_Y as Integer 
 
    Max_Y as Integer
 
    
 
    col   as integer
 
    'Hier können später sonstige relevanten Daten eingefügt werden
 
    'sind für diesen Test aber nicht erforderlich
 
    
 
    'Zeichnet das Objekt
 
    Declare Sub Draw()
 
End Type
 
 
Sub ObjectData.Draw()
 
    with this
 
        line (.Min_X, .Min_Y) - (.Max_X, .Max_Y), .col, BF
 
    end with
 
End Sub
 
 
 
Function IfBoxKollision(BoxA_MinX as Integer, BoxA_MinY as Integer, BoxA_MaxX as Integer, BoxA_MaxY as Integer, _
 
                        BoxB_MinX as Integer, BoxB_MinY as Integer, BoxB_MaxX as Integer, BoxB_MaxY as Integer) as Integer
 
    
 
    Dim as Integer XLeft, YUp, XRight, YDown 'Eckpunkte des umschriebenen Rechtecks
 
    Dim as Integer BoxA_LenX, BoxA_LenY, BoxB_LenX, BoxB_LenY 'Seitenlänge beider Rechtecke
 
    
 
    'Seitenlänge der Boxen feststellen
 
    BoxA_LenX = BoxA_MaxX-BoxA_MinX
 
    BoxA_LenY = BoxA_MaxY-BoxA_MinY
 
    BoxB_LenX = BoxB_MaxX-BoxB_MinX
 
    BoxB_LenY = BoxB_MaxY-BoxB_MinY
 
    
 
    'Bestimmen der Eckpunktkoordinaten
 
    XLeft  = IIF(BoxA_MinX<BoxB_MinX, BoxA_MinX, BoxB_MinX)        'links
 
    YUp    = IIF(BoxA_MinY<BoxB_MinY, BoxA_MinY, BoxB_MinY)        'oben
 
    XRight = IIF(BoxA_MaxX>BoxB_MaxX, BoxA_MaxX, BoxB_MaxX)        'rechts
 
    YDown  = IIF(BoxA_MaxY>BoxB_MaxY, BoxA_MaxY, BoxB_MaxY)        'unten
 
    
 
    'Prüfen auf Kollision
 
    If ( (BoxA_LenX + BoxB_LenX) > (XRight - XLeft) ) And ( (BoxA_LenY + BoxB_LenY) > (YDown - YUp)) Then Return 1
 
    Return 0
 
End Function 
 
 
'' Quadtree
 
 
Type Quadtree
 
    Declare Constructor()
 
    Declare Constructor(minx as Integer, miny as Integer, maxx as integer, maxy as integer)
 
    
 
    'Enthält die Eckpunkte des Node
 
    Min_X as Integer 
 
    Max_X as Integer
 
    Min_Y as Integer 
 
    Max_Y as Integer
 
 
    'Tiefe des Baums (0 = Wurzel)
 
    Depth as Integer
 
    
 
    'IsSplit: wurde bereits geteilt? (TRUE/FALSE) 
 
    IsSplit as Integer
 
    
 
    'Enthält die 4 Child Nodes
 
    Node(0 to 3) as Quadtree ptr
 
    
 
    'Teilt das Node in 4 neue Child Nodes
 
    Declare Function Split() as Integer
 
    
 
    'Trägt einen Verweis eines Objekts in den Baum
 
    Declare Sub AddObject(NewObject as ObjectData ptr)
 
    
 
    'Enthält die Anzahl eingetragener Verweise zu Objekten
 
    Objects_Count as Integer
 
    
 
    'Liste der Verweise auf Objekte
 
    Objects_Data as ObjectData ptr ptr
 
    
 
    'Declare Sub Draw() ''Bei 3D wird die 'sichtbare Box' durch ein Frustum check ersetzt
 
    'Alle sichtbaren Nodes/Objekte im Baum zeichnen
 
    Declare Sub Draw(minx as integer, miny as integer, maxx as integer, maxy as integer)
 
End Type
 
 
Constructor Quadtree()
 
End Constructor
 
 
Constructor Quadtree(minx as Integer, miny as Integer, maxx as integer, maxy as integer)
 
    with this
 
        .Min_X = minx
 
        .Max_X = maxx
 
        .Min_Y = miny
 
        .Max_Y = maxy
 
    end with
 
End Constructor
 
 
Function Quadtree.Split() as Integer
 
    Dim as Integer CenterX, CenterY
 
    With this
 
        'Wenn Node bereits aufgeteilt ist ODER die maximale 
 
        'Tiefe erreicht hat, nicht weiter aufteilen.
 
        If (.IsSplit = 1) or (Depth = QuadMaxDepth) Then Return 0
 
        
 
        'Mittelpunkt des Nodes ermitteln
 
        CenterX = (.Min_X + ((.Max_X - .Min_X) / 2) )
 
        CenterY = (.Min_Y + ((.Max_Y - .Min_Y) / 2) )
 
        
 
        '4 Child Nodes erstellen
 
        
 
        'links oben
 
        .Node(0) = NEW Quadtree
 
        'Eckpunkte
 
        .Node(0) -> Min_X = .Min_X
 
        .Node(0) -> Max_X = CenterX
 
        .Node(0) -> Min_Y = .Min_Y
 
        .Node(0) -> Max_Y = CenterY
 
        'Tiefe
 
        .Node(0) -> Depth = .Depth+1
 
        
 
        'recht oben
 
        .Node(1) = NEW Quadtree
 
        .Node(1) -> Min_X = CenterX
 
        .Node(1) -> Max_X = .Max_X
 
        .Node(1) -> Min_Y = .Min_Y
 
        .Node(1) -> Max_Y = CenterY
 
        'Tiefe
 
        .Node(1) -> Depth = .Depth+1
 
        
 
        'links unten
 
        .Node(2) = NEW Quadtree
 
        .Node(2) -> Min_X = .Min_X
 
        .Node(2) -> Max_X = CenterX
 
        .Node(2) -> Min_Y = CenterY
 
        .Node(2) -> Max_Y = .Max_Y
 
        'Tiefe
 
        .Node(2) -> Depth = .Depth+1
 
        
 
        'rechts unten
 
        .Node(3) = NEW Quadtree
 
        .Node(3) -> Min_X = CenterX
 
        .Node(3) -> Max_X = .Max_X
 
        .Node(3) -> Min_Y = CenterY
 
        .Node(3) -> Max_Y = .Max_Y
 
        'Tiefe
 
        .Node(3) -> Depth = .Depth+1
 
        
 
        'Festhalten das Node geteilt wurde
 
        .IsSplit = 1
 
    End With
 
    Return 1
 
End Function
 
 
Sub Quadtree.AddObject(NewObject as ObjectData ptr)
 
    Dim CenterX as Integer
 
    Dim CenterY as Integer
 
    
 
    Dim Temp as any ptr
 
    
 
    with this
 
        'Mittelpunkt des Nodes ermitteln
 
        CenterX = (.Min_X + ((.Max_X - .Min_X) / 2) )
 
        CenterY = (.Min_Y + ((.Max_Y - .Min_Y) / 2) )
 
 
        'Prüfen ob Node noch teilbar ist (QuadMaxDepth)
 
        If .Depth < QuadMaxDepth Then
 
            
 
           'Prüfen ob Object in einem tieferen Node passt
 
            
 
           'links oben?
 
           If ((NewObject -> Min_X) >= .Min_X ) and ((NewObject -> Min_Y) >= .Min_Y ) and _
 
              ((NewObject -> Max_X) <= CenterX) and ((NewObject -> Max_Y) <= CenterY) Then
 
               'Object passt eine Ebene tiefer, ins Node links oben!
 
               
 
               'Wenn Node noch nicht geteilt ist, dann jetzt teilen.
 
               If (.IsSplit = 0) Then .Split()
 
               
 
               'Objekt ins nächste Child Node übergeben.
 
               .Node(0) -> AddObject(NewObject)
 
               Exit Sub
 
           End If'elseif verwenden?
 
           
 
           ' rechts oben?
 
           If ((NewObject -> Min_X) >= CenterX) and ((NewObject -> Min_Y) >= .Min_Y ) and _
 
              ((NewObject -> Max_X) <= .Max_X ) and ((NewObject -> Max_Y) <= CenterY) Then
 
               'Object passt eine Ebene tiefer, ins Node links oben!
 
               
 
               'Wenn Node noch nicht geteilt ist, dann jetzt teilen.
 
               If (.IsSplit = 0) Then .Split()
 
               
 
               'Objekt ins nächste Child Node übergeben.
 
               .Node(1) -> AddObject(NewObject)
 
               Exit Sub
 
           End If
 
           
 
           ' links unten?
 
           If ((NewObject -> Min_X) >= .Min_X ) and ((NewObject -> Min_Y) >= CenterY) and _
 
              ((NewObject -> Max_X) <= CenterX) and ((NewObject -> Max_Y) <= .Max_Y ) Then
 
               'Object passt eine Ebene tiefer, ins Node links oben!
 
               
 
               'Wenn Node noch nicht geteilt ist, dann jetzt teilen.
 
               If (.IsSplit = 0) Then .Split()
 
               
 
               'Objekt ins nächste Child Node übergeben.
 
               .Node(2) -> AddObject(NewObject)
 
               Exit Sub
 
           End If
 
           
 
           ' rechts unten?
 
           If ((NewObject -> Min_X) >= CenterX) and ((NewObject -> Min_Y) >= CenterY) and _
 
              ((NewObject -> Max_X) <= .Max_X ) and ((NewObject -> Max_Y) <= .Max_Y ) Then
 
               'Object passt eine Ebene tiefer, ins Node links oben!
 
               
 
               'Wenn Node noch nicht geteilt ist, dann jetzt teilen.
 
               If (.IsSplit = 0) Then .Split()
 
               
 
               'Objekt ins nächste Child Node übergeben.
 
               .Node(3) -> AddObject(NewObject)
 
               Exit Sub
 
           End If
 
        End If
 
        
 
        'Objekt passt in keine tiefere Ebene oder maximale teilung ist erreicht
 
        'Objekt Verweis hier speichern
 
        
 
        Temp = reallocate (.Objects_Data, (.Objects_Count+1)*4) 'Speicher realloziieren
 
        .Objects_Data = Temp
 
        .Objects_Data[.Objects_Count] = NewObject           'Neuen Verweis eintragen
 
        .Objects_Count += 1                                 'Objektzähler um 1 erhöhen
 
    End With
 
End Sub
 
 
'Sub Quadtree.Draw()        
 
Sub Quadtree.Draw(minx as integer, miny as integer, maxx as integer, maxy as integer)
 
    with this
 
        'Sonderfall!
 
        'Objekte die, wegen ihrer grösser und/oder position nur in der 
 
        'Wurzel passten, müssen einzeln auf Sichtbarkeit geprüft werden! 
 
        
 
        'Schneidet dieses Node unseren Sichtbaren Bereich?
 
        If IfBoxKollision(.Min_X, .Min_Y, .Max_X, .Max_Y, _
 
                          minx, miny, maxx, maxy) = 1 Then
 
            
 
            If (.Objects_Count > 0) Then
 
                'Befinden wir uns in der Wurzel des Baums 
 
                If (.Depth = 0) Then
 
                    'Jedes Objekt auf sichtbarkeit prüfen
 
                    for i as integer=0 to Objects_Count-1
 
                        If IfBoxKollision( (.Objects_Data[i] -> Min_X), (.Objects_Data[i] -> Min_Y), _
 
                                           (.Objects_Data[i] -> Max_X), (.Objects_Data[i] -> Max_Y), _
 
                                            minx, miny, maxx, maxy ) = 1 Then Objects_Data[i] -> Draw()
 
                    Next i
 
                Else
 
                    for i as integer=0 to Objects_Count-1
 
                        Objects_Data[i] -> Draw()
 
                    next i
 
                End If
 
                
 
                'Debugline
 
                line (.Min_X, .Min_Y) - (.Max_X, .Max_Y), &hFF999999, B
 
            End If                
 
                
 
            'Wenn Node geteilt dann untere Bäume Zeichnen
 
            If (.IsSplit=1) Then
 
                .Node(0) -> Draw(minx,miny,maxx,maxy)
 
                .Node(1) -> Draw(minx,miny,maxx,maxy)
 
                .Node(2) -> Draw(minx,miny,maxx,maxy)
 
                .Node(3) -> Draw(minx,miny,maxx,maxy)
 
            End If
 
        End If
 
    End with
 
End Sub        
 
 
 
''Screen
 
Screenres 800,600,32
 
 
''Welt/Quadtree
 
Dim Welt as Quadtree
 
Welt=Type<Quadtree>(0,0,800,600)
 
 
''Testobjekte erstellen
 
Dim as Integer rndStartX, rndStartY, rndSize, rndCol
 
Dim testobjekte as ObjectData ptr ptr
 
testobjekte=callocate(AnzahlObjekte*4)
 
 
'Dim as Integer XS, YS
 
for i as integer=0 to AnzahlObjekte-1
 
    'rndStartX = rnd * 800
 
    'rndStartY = rnd * 600
 
    rndSize   = 18'rnd * 50
 
    
 
    rndCol    = rnd * &hFFFFFF
 
    
 
    testobjekte[i] = NEW ObjectData
 
    testobjekte[i] -> Min_X = rndStartX
 
    testobjekte[i] -> Min_Y = rndStartY
 
    testobjekte[i] -> Max_X = rndStartX+rndSize
 
    testobjekte[i] -> Max_Y = rndStartY+rndSize
 
    testobjekte[i] -> col   = rndcol
 
    
 
    Welt.AddObject(testobjekte[i])
 
    
 
    rndStartX += 20 : if (rndStartX > 799) Then rndStartY += 20 : rndStartX = 0
 
next i
 
 
Dim as Integer MouseX, MouseY
 
Dim as Integer vminX, vminY, vmaxX, vmaxY
 
 
do
 
    getmouse MouseX, MouseY
 
    
 
    vminX=MouseX-100 : if vminX<0 then vminX=0
 
    vminY=MouseY-100 : if vminY<0 then vminY=0
 
    
 
    vmaxX=MouseX+100 : if vmaxX>799 then vmaxX=799
 
    vmaxY=MouseY+100 : if vmaxY>599 then vmaxY=599    
 
    
 
    screenlock
 
        cls
 
        Welt.Draw(vminX,vminY,vmaxX,vmaxY)
 
        
 
        line (vminX,vminY) - (vmaxX, vmaxY), &hFF333333, B
 
    screenunlock    
 
    
 
    sleep 1
 
loop until multikey(&h01)
 
 | 	  
 
 
Edit: bekam gerade ein Fehler als ich die Zeile
 
 	  | Code: | 	 		  | rndCol = rnd * &hFFFFFF | 	  
 
zu dieser
 
 
geändert habe, mit dem ich irgendwie nichts anfangen kann...
 
 
 	  | Zitat: | 	 		  
 
D:\FreeBASIC\lib/libfb.a(math_rnd.o):math_rnd.c .text+0x63a): undefined reference to `CryptAcquireContextA@20'
 
D:\FreeBASIC\lib/libfb.a(math_rnd.o):math_rnd.c .text+0x672): undefined reference to `CryptGenRandom@12'
 
D:\FreeBASIC\lib/libfb.a(math_rnd.o):math_rnd.c .text+0x69d): undefined reference to `CryptReleaseContext@8'
 
 | 	  
 
 
Edit:
 
kann es sein das ich mir irgendwie was zerschossen habe?
 
 
Wenn ich randomize timer reinhauen will kommt dieser fehler...
 
irgendwie die lib geschrottet?!" _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Eternal_pain
 
  
  Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
  | 
		
			
				 Verfasst am: 22.05.2012, 13:17    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				Schein mir wirklich was zerschossen zu haben, FB neu istalliert und behoben  
 
 
So, hab nun beide Varianten meines Quadtree's nochmal probiert:
 
 
Edit: Falsche beschreibungen im Source  
 
 
Variante 1
 
 
'Objekte werden nach Ihrer Grösser ins Quadtree abgelegt und ein Verweis nur einmal im gesamten Baum gespeichert
 
'Sonderfallbehandlung: Objekte werden auch in der Wurzel des Baums abgelegt
 
 
'Vorteil  - Objekt-Verweise sind nur einmal vorhanden, eine Prüfung ob Objekt bereits gezeichnet wurde entfällt
 
'         - Quadtree wird nur so oft geteilt wie unbedingt nötig
 
 
'Nachteil - Eine Menge (nicht sichtbare) überflüssiger Objekte wird gezeichnet
 
 
Variante 2
 
 
'Objekte werden in JEDES Node abgelegt das es schneidet
 
 
'Vorteil  - Es werden nur ein minimum an Sichtbaren Objekte gezeichnet
 
 
'Nachteil - Das einlagern erfordert je nach maximaler Tiefe mehr Zeit
 
'           Objekte werden mehrfach im Baum verwiesen und müssen daher geprüft werden ob sie bereits gezeichnet sind
 
'           Quadtree wird IMMER bis zur maximaltiefe geteilt
 
 
 
Beide haben Ihre Vor- und Nachteile, aber ich glaube ich bleibe bei Variante1
 
 
 
Oder sollte ich doch noch eine Dritte Variante versuchen?
 
XOR's Vorschlag, (maximale Anzahl Objekte per Node??) _________________
   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		 | 
	 
 
  
	 
	    
	   | 
	
Du kannst keine Beiträge in dieses Forum schreiben. Du kannst auf Beiträge in diesem Forum nicht antworten. Du kannst deine Beiträge in diesem Forum nicht bearbeiten. Du kannst deine Beiträge in diesem Forum nicht löschen. Du kannst an Umfragen in diesem Forum nicht mitmachen.
  | 
   
 
     |