;==================================================================
;==================================================================
; Definit le Frustum
Global p1x#,p1y#
Global p2x#,p2y#
; Enfants du Quadtree
Const CHILD00 = 0
Const CHILD01 = 1
Const CHILD11 = 2
Const CHILD10 = 3
; CAMERA
Type CAMERA
Field x#,y# ; Position de la camera
Field fov# ; Angle de vue
End Type
; creation d'une camera
Function Camera.CAMERA(x,y,fov)
this.CAMERA = New CAMERA
this\x = x : this\y = y : this\fov = fov
Return this
End Function
; Renvoie True si un point est dans le plan Left du Frustum
Function PointInFrustumL(this.CAMERA,x,y)
Return ( -(x - this\x) * (p1y - this\y) + (y - this\y) * (p1x - this\x) >= 0)
End Function
; Renvoie True si un point est dans le plan Right du Frustum
Function PointInFrustumR(this.CAMERA,x,y)
Return ( -(x - this\x) * (p2y - this\y) + (y - this\y) * (p2x - this\x) <= 0)
End Function
; Renvoie True si un point est dans le plan Front du Frustum (pas utilise' ici)
Function PointInFrustumF(this.CAMERA,x,y)
Return ( -(x - this\x) * (p3y - this\y) + (y - this\y) * (p3x - this\x) >= 0)
End Function
; QUADTREE
Type QUADTREE
Field Child.QUADTREE[3] ; Les 4 enfants du quadtree
Field xmin#,ymin# ; Coordonne'es du sommet haut gauche
Field xmax#,ymax# ; Coordonne'es du sommet bas droite
Field dist%
Field qred,qgreen,qblue,qcolor
End Type
; Creation d'un quadtree de profondeur depth
; et associe' a` un carre' de cote's xmax-xmin, ymax-ymin
Function Quadtree.QUADTREE(xmin,ymin,xmax,ymax,depth)
this.QUADTREE = New QUADTREE
this\xmin = xmin
this\xmax = xmax
this\ymin = ymin
this\ymax = ymax
this\dist = 1
; this\qred = Rand(0,255)
; this\qgreen = Rand(0,255)
; this\qblue = Rand(0,255)
qcolor = CombineARGB#(0,Rand(0,255),Rand(0,255),Rand(0,255))
this\qcolor = Int( qcolor)
If (depth > 0)
; On cre'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
Return this
End Function
; On teste si un des 4 sommets du carre' associe' au quadtree
; est visible par la camera
Function QuadInFrustum(this.QUADTREE,cam.CAMERA)
Local 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 Return False
; 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 Return False
Return True
End Function
; Rendu du Quadtree
Function RenderQuadtree(this.QUADTREE,cam.CAMERA,depth)
this\dist = (Dist#( cam\x, cam\y, this\xmin, this\ymin )/100)
If this\dist<1 Then this\dist=1
If QuadInFrustum(this,cam)
If (depth > this\dist)
Color 128,128,128
; Line (this\xmin+this\xmax)/2,this\ymin,(this\xmin+this\xmax)/2,this\ymax
; Line 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
LockBuffer BackBuffer()
; Color this\qred,this\qgreen,this\qblue
For b= this\ymin To this\ymax ;Step 1
For a= this\xmin To this\xmax ;Step 1
WritePixelFast a,b, this\qcolor , BackBuffer() ;this\qcolor
Next
Next
UnlockBuffer BackBuffer()
EndIf
EndIf
End Function
;==============================================================================================
; EXAMPLE
;==============================================================================================
AppTitle "Simple Quadtree Demo - Seyhajin"
Graphics 512,512,0,2
SetBuffer BackBuffer()
; Variables de configuration
QuadDepth = 10 ; Profondeur du quadtree (nb de fois qu'on decoupe le plan)
QuadSize = 512 ; Taille initiale du quadtree
CamSpeed# = 2 ; Vitesse de deplacement de la camera
CamFOV# = 60.0 / 2.0 ; Angle de vue de la camera (default = 90)
ViewLine = 300 ; Taille de la ligne des plans 300
; 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
;----------------------------------
While Not KeyHit(1)
Cls
; Update Camera position
If KeyDown(200) ; Up
cam\y = cam\y - CamSpeed#
ElseIf KeyDown(208) ; Down
cam\y = cam\y + CamSpeed#
EndIf
If KeyDown(203) ; Left
cam\x = cam\x - CamSpeed#
ElseIf KeyDown(205) ; Right
cam\x = cam\x + CamSpeed#
EndIf
; Rendu du quadtree
Color 255,255,255
Rect root\xmin,root\ymin,root\xmax,root\ymax,1
RenderQuadtree(root,cam,QuadDepth)
; Dessine la pyramide de vue (Frustum)
x# = MouseX() - cam\x
y# = MouseY() - cam\y
angle# = 180+ATan2(-y#,-x#)
Color 255,255,0
Line cam\x,cam\y,cam\x+(ViewLine)*Cos(angle#),cam\y+(ViewLine)*Sin(angle#)
Color 255,0,0
; Plan gauche
p1x = cam\x+ViewLine*Cos(angle#-CamFOV)
p1y = cam\y+ViewLine*Sin(angle#-CamFOV)
Line cam\x,cam\y,p1x,p1y
; Plan droit
p2x = cam\x+ViewLine*Cos(angle#+CamFOV)
p2y = cam\y+ViewLine*Sin(angle#+CamFOV)
Line cam\x,cam\y,p2x,p2y
; Dessine la camera
Color 0,0,255
Oval cam\x-3,cam\y-3,6,6,True
d =Dist#( cam\x, cam\y, mx, my )
Text 400,400,(d/100)
Flip
Wend
Delete Each CAMERA
Delete Each QUADTREE
End
Function Dist#( X1#, Y1#, X2#, Y2# )
Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
; combine Alpha, Red, Green, Blue values to a RGB value
Function CombineARGB#(aa#,rr%,gg%,bb%)
;Return aa*$1000000+rr*$10000+gg*$100+bb
Return $ff000000 Or rr Shl 16 Or gg Shl 8 Or bb
End Function