PureBasic

Dimanche en faisant une recherche sur les quadtree je suis tombé sur ce site :
http://bond357.free.fr/main/forums/viewtopic.php?id=10

je viens de le traduire pour PureBasic, c'est du vite fait, c'est un simple copier/coller.

J'espère que son auteur (qui fréquente ce forum) ne m'en voudra pas d'avoir repris ce code ?

Code : Tout sélectionner

;==================================================================
;  Project Title : Simple Quadtree Demo
;
;  Author : Seyhajin
;
;  Email : seyhajin@hotmail.com
;
;  Website : http://www.seyhajin.com
;            http://bond357.free.fr/main/forums/viewtopic.php?id=10
;
;  Version : 1.0
;
;  Date : 12/03/2006
;
;  Notes : Utilisation du Quadtree et du Frustum Culling, dans un univers 2D.
;
;  Commandes :
;      - Touches direct. : Bouge la camera
;      - Mouse : Definit l'orientation de la camera
;
;  References :
;      - mon poto Google :o)
;      - http://www.flipcode.com/articles/article_frustumculling.shtml
;      - http://deptinfo.unice.fr/twiki/bin/view/Minfo03/AlgosJeux3DRapportFrustum
;
;==================================================================


; Definit le Frustum 
Global p1.POINT, p2.POINT

Macro CosD(x)
  Cos((x)*0.0174532)
EndMacro
Macro SinD(x)
  Sin((x)*0.0174532)
EndMacro

; Enfants du Quadtree
Enumeration 
  #CHILD00 
  #CHILD01 
  #CHILD11 
  #CHILD10
EndEnumeration


; CAMERA
Structure CAMERA
  x.l      ; Position de la camera
  y.l      ; Position de la camera
  fov.l      ; Angle de vue
EndStructure

; QUADTREE
Structure QUADTREE
  xmin.l              ; Coordonnées du sommet haut gauche
  ymin.l              ; Coordonnées du sommet haut gauche
  xmax.l              ; Coordonnées du sommet bas droite
  ymax.l              ; Coordonnées du sommet bas droite
  *Child.QUADTREE[4]  ; Les 4 enfants du quadtree
EndStructure 

; creation d'une camera
; creation d'une camera
Procedure Camera(x,y,fov)
  *this.CAMERA = AllocateMemory(SizeOf(CAMERA))
  *this\x = x : *this\y = y : *this\fov = fov
  ProcedureReturn *this
EndProcedure

; Renvoie True si un point est dans le plan Left du Frustum
Procedure PointInFrustumL(*this.CAMERA,x,y)
  If (-(x - *this\x) * (p1\y - *this\y) + (y - *this\y) * (p1\x - *this\x) >= 0)
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure 

; Renvoie True si un point est dans le plan Right du Frustum
Procedure PointInFrustumR(*this.CAMERA,x,y)
  If ( -(x - *this\x) * (p2\y - *this\y) + (y - *this\y) * (p2\x - *this\x) <= 0)
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure 

; Renvoie True si un point est dans le plan Front du Frustum (pas utilisé ici)
Procedure PointInFrustumF(*this.CAMERA,x,y)
  ProcedureReturn ( -(x - *this\x) * (p3y - *this\y) + (y - *this\y) * (p3x - *this\x) >= 0)
EndProcedure 

; Creation d'un quadtree de profondeur depth
; et associé à un carré de cotés xmax-xmin, ymax-ymin
Procedure Quadtree(xmin,ymin,xmax,ymax,depth)
  *this.QUADTREE = AllocateMemory(SizeOf(QUADTREE))
  *this\xmin = xmin
  *this\xmax = xmax
  *this\ymin = ymin
  *this\ymax = ymax

  If (depth > 0)
    ; On crée 4 enfants
    xmoy = (xmin+xmax) / 2
    ymoy = (ymin+ymax) / 2
    depth = depth - 1
    *this\Child[#CHILD00] = Quadtree(xmin,ymin,xmoy,ymoy,depth) ; Haut gauche
    *this\Child[#CHILD01] = Quadtree(xmin,ymoy,xmoy,ymax,depth) ; Bas gauche
    *this\Child[#CHILD11] = Quadtree(xmoy,ymoy,xmax,ymax,depth) ; Bas droite
    *this\Child[#CHILD10] = Quadtree(xmoy,ymin,xmax,ymoy,depth) ; Haut droite
  EndIf
  ProcedureReturn *this
EndProcedure  

; On teste si un des 4 sommets du carré associé au quadtree
; est visible par la camera
Procedure QuadInFrustum(*this.QUADTREE,*cam.CAMERA)
  Define nbPlansInterieur

  ; Plan de gauche
  nbPlansInterieur = 0
  nbPlansInterieur = nbPlansInterieur + PointInFrustumL(*cam,*this\xmin,*this\ymin)
  nbPlansInterieur = nbPlansInterieur + PointInFrustumL(*cam,*this\xmin,*this\ymax)
  nbPlansInterieur = nbPlansInterieur + PointInFrustumL(*cam,*this\xmax,*this\ymin)
  nbPlansInterieur = nbPlansInterieur + PointInFrustumL(*cam,*this\xmax,*this\ymax)
  If nbPlansInterieur = 0 : ProcedureReturn #False : EndIf

  ; Plan de droite
  nbPlansInterieur = 0
  nbPlansInterieur = nbPlansInterieur + PointInFrustumR(*cam,*this\xmin,*this\ymin)
  nbPlansInterieur = nbPlansInterieur + PointInFrustumR(*cam,*this\xmin,*this\ymax)
  nbPlansInterieur = nbPlansInterieur + PointInFrustumR(*cam,*this\xmax,*this\ymin)
  nbPlansInterieur = nbPlansInterieur + PointInFrustumR(*cam,*this\xmax,*this\ymax)
  If nbPlansInterieur = 0 : ProcedureReturn #False : EndIf

  ProcedureReturn #True
EndProcedure 

; Rendu du Quadtree
Procedure RenderQuadtree(*this.QUADTREE,*cam.CAMERA,depth)
  If QuadInFrustum(*this,*cam)
    If (depth > 1)
      FrontColor(#Gray)
      LineXY((*this\xmin+*this\xmax)/2,*this\ymin,(*this\xmin+*this\xmax)/2,*this\ymax)
      LineXY(*this\xmin,(*this\ymin+*this\ymax)/2,*this\xmax,(*this\ymin+*this\ymax)/2)
      
      depth = depth - 1
      
      RenderQuadtree(*this\Child[#CHILD00],*cam,depth)
      RenderQuadtree(*this\Child[#CHILD01],*cam,depth)
      RenderQuadtree(*this\Child[#CHILD11],*cam,depth)
      RenderQuadtree(*this\Child[#CHILD10],*cam,depth)
    Else
      FrontColor(RGB(196,196,196))
      Box(*this\xmin+1,*this\ymin+1,*this\xmax-*this\xmin-1,*this\ymax-*this\ymin-1)
    EndIf 
  EndIf 
EndProcedure  

Procedure.f Atan2(y.f,x.f)
  !fld dword[p.v_y]
  !fld dword[p.v_x]
  !fpatan
  ProcedureReturn
EndProcedure 

;==============================================================================================
; EXAMPLE
;==============================================================================================

InitSprite()
InitMouse()
InitKeyboard()
OpenScreen(800,600,32,"Simple Quadtree Demo - Seyhajin")
; Variables de configuration
QuadDepth = 6            ; Profondeur du quadtree (nb de fois qu'on decoupe le plan)
QuadSize = 599           ; Taille initiale du quadtree
CamSpeed.f = 2           ; Vitesse de deplacement de la camera
CamFOV.f = 60.0 / 2.0    ; Angle de vue de la camera (default = 90)
ViewLine = 200           ; Taille de la ligne des plans

; Creation de la camera
*cam.CAMERA=camera(QuadSize/2,QuadSize/2,CamFOV)
; Creation du Quadtree principale
*root.QUADTREE=Quadtree(0,0,QuadSize,QuadSize,QuadDepth)

;----------------------------------
; BOUCLE PRINCIPALE
;----------------------------------
Repeat

  ClearScreen(#Black)
  

  ; Update Camera position
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Up)
    *cam\y = *cam\y - CamSpeed
  ElseIf KeyboardPushed(#PB_Key_Down)
    *cam\y = *cam\y + CamSpeed
  EndIf
  If KeyboardPushed(#PB_Key_Left)
    *cam\x = *cam\x - CamSpeed
  ElseIf KeyboardPushed(#PB_Key_Right)
    *cam\x = *cam\x + CamSpeed
  EndIf
  
  If ExamineMouse()
    x.f = MouseX() - *cam\x
    y.f = MouseY() - *cam\y
    angle.f = 180+(ATan2(-y,-x)*57.295779)
  EndIf

  ; Rendu du quadtree
  StartDrawing(ScreenOutput())
  Box(*root\xmin,*root\ymin,*root\xmax,*root\ymax,#White)
  RenderQuadtree(*root,*cam,QuadDepth)

  ; Dessine la pyramide de vue (Frustum)
  LineXY(*cam\x,*cam\y,*cam\x+(ViewLine/2)*CosD(angle),*cam\y+(ViewLine/2)*SinD(angle),#Yellow)
  ; Plan gauche
  p1\x = *cam\x+ViewLine*CosD(angle-CamFOV)
  p1\y = *cam\y+ViewLine*SinD(angle-CamFOV)
  LineXY(*cam\x,*cam\y,p1\x,p1\y,#Red)
  ; Plan droit
  p2\x = *cam\x+ViewLine*CosD(angle+CamFOV)
  p2\y = *cam\y+ViewLine*SinD(angle+CamFOV)
  LineXY(*cam\x,*cam\y,p2\x,p2\y,#Red)
  ; Dessine la camera
  Circle(*cam\x,*cam\y,6,#Blue)
  StopDrawing()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Pas de probleme Comtois

, fais en bonne usage.

et nous aussi

merci à tous les deux.

c'est dr dri il me semble qui avait une démo bien sympa aussi dans le genre.

Ca traine sur mon disque dur ^_^
Et si je me rappelle bien on connait les quadtree sur ce forum grace à comtois ^^

Dri

Voici ma version d'un Quadtree. L'espace est découpé en fonction des objets présent dans la scène 2D.

Il y a deux paramètres pour gérer la répartition.

#QuadObjet pour indiquer le nombre maxi d'objet par zone.
S'il y a beaucoup d'objets, ce seul paramètre est insuffisant car on pourrait ne jamais satisfaire cette condition, aussi il y a un deuxième paramètre qui permet de limiter le nombre de découpage, #QuadDepth.

Code : Tout sélectionner

;Comtois le 03/02/07
;Exemple de construction d'un quadtree avec répartition des objets
;Vous pouvez changer la valeur de #QuadObjet pour constater le changement de répartition
;

Structure s_Objet
  x.l
  y.l
  Rayon.l
EndStructure

Structure s_Boite
  Xmini.l
  Ymini.l
  Xmaxi.l
  Ymaxi.l
EndStructure

Structure s_QuadTree
  Depth.l
  Boite.s_Boite
  NbObjets.l
  *Liste.s_Objet  
  *Fils.s_QuadTree[4]
EndStructure

;-Declaration des procédures
Declare ConstructionQuadTree(*Noeud.s_QuadTree, *Boite.s_Boite, *Liste.s_Objet, NbObjets)
Declare RenderQuadtree(*this.s_QuadTree)

;-Variables de configuration
#NbObjets  =  50           ; Nombre d'objets dans la scène 
#QuadSize  = 599          ; Taille initiale du quadtree
#QuadDepth = 5            ; Profondeur du quadtree (nb de fois qu'on decoupe le plan)
#QuadObjet = 1            ; Nombre d'objets maxi par Noeud
#Rayon     = 3            ; Rayon d'un objet

Dim ListeInitiale.s_Objet(#NbObjets-1)    
Define.s_QuadTree NoeudInitial
Define.s_Boite BoiteInitiale

;-Initialise une boite
Procedure InitBoite(*this.s_Boite, Xmini, Xmaxi, Ymini, Ymaxi)
  With *this
    \Xmini = Xmini  
    \Xmaxi = Xmaxi
    \Ymini = Ymini
    \Ymaxi = Ymaxi
  EndWith
EndProcedure

;Création d'une liste d'objets (sphères dans cet exemple)
Procedure CreationListe(this.s_Objet(1))
  For i=0 To #NbObjets-1
    this(i)\x = Random(#QuadSize-#Rayon)
    this(i)\y = Random(#QuadSize-#Rayon)
    this(i)\Rayon = #Rayon   
  Next i
EndProcedure

;Construction du quadtree avec répartition des objets 
Procedure ConstructionQuadTree(*Noeud.s_QuadTree, *Boite.s_Boite, *Liste.s_Objet, NbObjets)
  Define.s_Boite BoiteFils
  Define.s_Objet *ListeFils, *Ptr
  ;Define.s_Vecteur CentreBoite, DemiDimensionBoite
  Define.s_QuadTree	 *PtrF
  Define.l x, y, z, i, t, NbObjetsFils
   
  NewList Liste.s_Objet()
  
  *Noeud\Boite\Xmini = *Boite\Xmini
  *Noeud\Boite\Xmaxi = *Boite\Xmaxi
  *Noeud\Boite\Ymini = *Boite\Ymini
  *Noeud\Boite\Ymaxi = *Boite\Ymaxi

  ; Le noeud peut être partagé ?
  If NbObjets > #QuadObjet And *Noeud\Depth < #QuadDepth

    ;On répartit les objets dans les noeuds fils

    For y = 0 To 1 
      For x = 0 To 1
        
        ;No du fils 
        i = (y << 1) | x
        
        ;Boite englobante du fils i
        BoiteFils\Xmini = (1.0 - x / 2.0) * *Boite\Xmini  + x / 2.0 * *Boite\Xmaxi
        BoiteFils\Xmaxi = BoiteFils\Xmini + (*Boite\Xmaxi - *Boite\Xmini) / 2.0
        BoiteFils\Ymini = (1.0 - y / 2.0) * *Boite\Ymini  + y / 2.0 * *Boite\Ymaxi
        BoiteFils\Ymaxi = BoiteFils\Ymini + (*Boite\Ymaxi - *Boite\Ymini) / 2.0  
         
        *Ptr = *Liste 
        
        ClearList(Liste())
          
        For t = 1 To NbObjets 

          ; Calcul les objets en collision avec la boite du fils i
          If *Ptr\x > BoiteFils\Xmini And *Ptr\x < BoiteFils\Xmaxi And *Ptr\y > BoiteFils\Ymini And *Ptr\y < BoiteFils\Ymaxi
              
            AddElement(Liste())

            CopyMemory(*Ptr, Liste(), SizeOf(s_Objet))
           
          EndIf
          
          *Ptr + SizeOf(s_Objet)
         
        Next t

        NbObjetsFils = CountList(Liste())
        
        *ListeFils = #Null 
        
        If NbObjetsFils  
          
          *ListeFils = AllocateMemory(SizeOf(s_Objet) * NbObjetsFils)
          *Ptr = *ListeFils
          
          ForEach Liste()
            CopyMemory(Liste(), *Ptr, SizeOf(s_Objet))
            *Ptr + SizeOf(s_Objet)
          Next 
          
        EndIf

        ;Ajoute un Noeud
        *Noeud\Fils[i]=AllocateMemory(SizeOf(s_QuadTree))
      
        *PtrF = *Noeud\Fils[i]
        *PtrF\Depth = *Noeud\Depth + 1
      
        ConstructionQuadTree(*Noeud\Fils[i], @BoiteFils, *ListeFils, NbObjetsFils)
        
      Next x
    Next y 

  Else 
  
    ; Affecte la liste au noeud en cours
    *Noeud\Liste = *Liste 
    *Noeud\NbObjets = NbObjets

  EndIf
  
EndProcedure

; Rendu du Quadtree
Procedure RenderQuadtree(*this.s_QuadTree)
  DrawingMode(#PB_2DDrawing_Outlined)
  Box(*this\Boite\xmini,*this\Boite\ymini,*this\Boite\xmaxi-*this\boite\xmini,*this\Boite\ymaxi-*this\Boite\ymini,#White)
  If *this\Liste
    *Ptr.s_Objet = *this\Liste
    For i = 0 To *this\NbObjets-1
      Circle(*Ptr\x,*Ptr\y, *Ptr\Rayon,#Red)
      *Ptr + SizeOf(s_Objet)
    Next i
  EndIf  
  For y = 0 To 1 
    For x = 0 To 1
      i = (y << 1) | x
      If *this\Fils[i]          
        RenderQuadtree(*this\Fils[i])
      EndIf
    Next x
  Next y 
EndProcedure  

;*******************
;- Exemple         * 
;*******************
If InitSprite()=0 Or InitMouse()=0 Or InitKeyboard()=0
  End
EndIf
  
OpenScreen(800,600,32,"Quadtree Demo")

InitBoite(@BoiteInitiale, 0, #QuadSize, 0, #QuadSize)
CreationListe(ListeInitiale())
ConstructionQuadTree(@NoeudInitial, @BoiteInitiale, ListeInitiale(), #NbObjets)

Repeat

  ClearScreen(#Black)
  
  ExamineKeyboard()
  ; Rendu du quadtree
  StartDrawing(ScreenOutput())
    RenderQuadtree(@NoeudInitial)
  StopDrawing()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

vraiement excelent ce découpage en fonction de la population d'un quad.

Mais cela ne s'applique que si les elements sont statique non ?

oui, mais c'est mieux que rien

c'est ce que j'utilisais pour gérer les collisions avec le décor (et c'était un octree mais le principe est le même).

Effectivement, pour ce genre d'emploi (gestion des collisions sur l'environement)
c'est top, et c'est très bien optimisé. Un principe a garder et enseigner ...

Seyhajin a écrit :Pas de probleme Comtois , fais en bonne usage.

j'ai aussi récupéré ce code pour mon forum de Code fr
visible ici : http://michel.dobro.free.fr/forum/

Moi aussi je récupère tous les codes intéressant ici : http://basicunivers.free.fr/index.php?p ... p&visited=.
N'hésitez pas à en mettre (y' pas besoin de s'inscrire !!!)

Je viens de tomber sur un article très intéressant sur l'utilisation d'un quadtree pour la construction d'un terrain, je mets le lien ici histoire d'insister sur l'utilité des quadtree

http://www.g-truc.net/article/lod.pdf

PureBasic

Simple Quadtree/Frustum Culling

Simple Quadtree/Frustum Culling