Bonjour,

J'aurai préféré pouvoir vous proposer le programme terminé mais j'ai un bug que je n'arrive pas à cerner... (désolé ce n'est pas optimisé, mal commenté...Mais ne soyez pas découragé par la longueur du prog, je n'ai qu'un -2 en fait- block startdrawing/stopdrawing)
Ce n'est pas systématique, mais souvent, je prends le message d'erreur du sujet. Je ne vois pas le problème, les blocs startdrawing/stopdrawing sont bien définis... Il me semble...

Peut être que cela vient d'une mauvaise utilisation des instructions 2d ou bien est ce que cela vient de ma configuration ???

Le problème survient ainsi: je lance la compil par F5 avec le debuggeur (sans le debuggueur, je plante tout simplement).
Ensuite je lance le partage récursif en quadtree en appuyant sur la touche 1. Enfin, avec la souris, je pointe des zones sous d'autres zones plus petites et je tape plusieurs fois la touche 5 pour les "réduires" par le haut.

Je tourne sur mon portable 4go, T1400, win7(32bts ed. integrale) et pb 4.41(x86)
Merci pour votre analyse et votre sagacité...

Fg
PS: pour que ça marche, modifiez les constantes #res_X et #res_Y qui sont la résolution de mon écran.
Code : Tout sélectionner
Macro Constantes
;constantes
#res_X=1366 ; résolution de l'écran en X
#res_Y=768 ;résolution de l'écran en Y
#largeur=512;nombre de case en largeur de la carte
#hauteur=512;nombre de case en hauteur de la carte
#temps=128
#ressource_bois=4; densité de la ressource sur la carte
EndMacro
Constantes
Macro Dim_Jeu
Structure Jeu
X.i ; coordonnée X de la case
Y.i ;coordonnée Y de la case
element.i ; numéro du perso() sur la case
couleur.i
visible.b ;=1 case visible =0 case cachée
quad.i
EndStructure
Structure noeud
quad.i
H.f
EndStructure
Structure quad1
x1.i
y1.i
x2.i
y2.i
couleur.i
voisin1.i
voisin2.i
warning.b
centre_X.i
centre_Y.i
EndStructure
Structure voisin1
quad.i
gate_X.i
gate_Y.i
Val.i
EndStructure
Global truc$
Global NewList open.noeud()
Global NewList close.noeud()
Global NewList liste.noeud()
Global Dim matrice.POINT(55000);contient les coordonnées relatives +1;-1 X et Y pour faires des tours... pendables
Global Dim tour.i(3000)
Global Dim jeu.Jeu(#largeur,#hauteur);aire de jeu
Global vois.i
Global feuille.i
Global Dim quad.quad1(1)
Global Dim voisin.voisin1(1)
Global elimine.i
Global skip.b
EndMacro
Dim_Jeu
Macro initialisation_ecran
;initialisation
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
MessageRequester("Error", "Can't open DirectX", 0)
End
EndIf
If OpenScreen(#res_X,#res_Y,32,"jeu",1,75)
Else
MessageRequester("Error", "Can't open screen !", 0):End
EndIf
EndMacro
initialisation_ecran
;creation du sprite de la "fleche"
CreateSprite(0,11,11)
StartDrawing(SpriteOutput(0))
LineXY(0,0,10,10,RGB(255,0,0))
LineXY(0,0,0,5,RGB(255,0,0))
LineXY(0,0,5,0,RGB(255,0,0))
StopDrawing()
TransparentSpriteColor(0,RGB(0,0,0))
Procedure eclater(x1.i,y1.i,x2.i,y2.i)
;si on a atteint le niveau de la case simple...
If x1=x2-1; Or y1=y2-1 ;rectangulaire...
If jeu(x1,y1)\element=0 ; et si cette case est inoccupée, on rajoute une feuille sinon...
feuille+1
ReDim quad(feuille)
quad(feuille)\x1=x1
quad(feuille)\x2=x2
quad(feuille)\y1=y1
quad(feuille)\y2=y2
quad(feuille)\couleur=RGB(Random(255),Random(255),Random(255))
EndIf
ProcedureReturn ;...on sort de la procedure
EndIf
;test la présence d'un obstacle dans la zone
For i=x1 To x2
For j=y1 To y2
If jeu(i,j)\element=0
vide=1
Else
obstacle=1
If vide:Break 2:EndIf
EndIf
Next j
Next i
;si la zone est entièrement rempli d'obstacles, on sort
If vide=0:ProcedureReturn:EndIf
;si la zone est entièrement vide, on rajoute une feuille et on sort
If obstacle=0
feuille+1
ReDim quad(feuille)
quad(feuille)\x1=x1
quad(feuille)\x2=x2
quad(feuille)\y1=y1
quad(feuille)\y2=y2
quad(feuille)\couleur=RGB(Random(255),Random(255),Random(255))
ProcedureReturn
EndIf
;subdivise par 2 les dimensions et on recommence pour chaque partie
x3 = (x1+x2)>>1
y3 = (y1+y2)>>1 ;
eclater(x1,y1,x3,y3)
eclater(x3,y1,x2,y3)
eclater(x1,y3,x3,y2)
eclater(x3,y3,x2,y2)
EndProcedure
Procedure voisiner(t.i)
;pour trouver les voisins d'un quad, on prend le quad et on balaye sa frontière dans le sens des aiguilles d'une montre
;*************************HAUT*******************
For X=quad(t)\x1 To quad(t)\x2 ;jusqu'a la diagonale haut/droit
y_haut=quad(t)\y1-1;limite haute du quad
If y_haut>=0;si on est dans la limite de la carte
;en haut
If voisin<>jeu(X,y_haut)\quad And jeu(X,y_haut)\quad<>0 ;chaque fois qu'on trouve un quad voisin différent du précédent trouvé et que ce n'est pas un obstacle...
vois+1 ;... on rajoute un voisin
ReDim voisin(vois)
voisin(vois)\quad=jeu(X,y_haut)\quad
;on sauve dans le quad les repères de début et de fin des voisins qui le concerne
If flag<>0
quad(t)\voisin2=vois;repère du dernier voisin
Else
quad(t)\voisin1=vois;repère du premier voisin
flag=1
EndIf
voisin=jeu(X,y_haut)\quad
EndIf
EndIf
Next X
;******************************DROITE************************
q=quad(t)\y2+1:If q>#hauteur:q=quad(t)\y2:EndIf
For Y=quad(t)\y1 To q ;jusqu'a la diagonale bas/droite
x_droit=quad(t)\x2+1
If x_droit<=#largeur
If voisin<>jeu(x_droit,Y)\quad And jeu(x_droit,Y)\quad<>0
vois+1
ReDim voisin(vois)
voisin(vois)\quad=jeu(x_droit,Y)\quad
If flag<>0
quad(t)\voisin2=vois
Else
quad(t)\voisin1=vois
flag=1
EndIf
voisin=jeu(x_droit,Y)\quad
EndIf
EndIf
Next Y
;*************************BAS*********************
q=quad(t)\x1-1:If q<0:q=0:EndIf
For X=quad(t)\x2-1 To q Step -1 ;jusqu'a la diagonale bas/gauche
y_bas=quad(t)\y2+1;limite basse du quad
If y_bas<=#hauteur
;idem pour le bas
If voisin<>jeu(X,y_bas)\quad And jeu(X,y_bas)\quad<>0
vois+1
ReDim voisin(vois)
voisin(vois)\quad=jeu(X,y_bas)\quad
If flag<>0
quad(t)\voisin2=vois
Else
quad(t)\voisin1=vois
flag=1
EndIf
voisin=jeu(X,y_bas)\quad
EndIf
EndIf
Next X
;*****************************GAUCHE***********************
q=quad(t)\y1-1:If q<0:q=0:EndIf
For Y=quad(t)\y2-1 To q Step -1 ;jusqu'a la diagonale haut/gauche
x_gauche=quad(t)\x1-1
If x_gauche>=0
If voisin<>jeu(x_gauche,Y)\quad And jeu(x_gauche,Y)\quad<>0
vois+1
ReDim voisin(vois)
voisin(vois)\quad=jeu(x_gauche,Y)\quad
If flag<>0
quad(t)\voisin2=vois
Else
quad(t)\voisin1=vois
flag=1
EndIf
voisin=jeu(x_gauche,Y)\quad
EndIf
EndIf
Next Y
If voisin=voisin(quad(t)\voisin1)\quad
vois-1
quad(t)\voisin2=vois
ReDim voisin(vois)
EndIf
EndProcedure
Procedure gate(t.i)
quad(t)\centre_X=quad(t)\x1+(quad(t)\x2-quad(t)\x1)>>1
quad(t)\centre_Y=quad(t)\y1+(quad(t)\y2-quad(t)\y1)>>1
jeu(quad(t)\centre_X,quad(t)\centre_Y)\couleur=RGB(0,0,255)
For i=quad(t)\voisin1 To quad(t)\voisin2 ;pour chaque voisin....
x1.i=quad(t)\x1:x2.i=quad(t)\x2
y1.i=quad(t)\y1:y2.i=quad(t)\y2
xx1.i=quad(voisin(i)\quad)\x1
xx2.i=quad(voisin(i)\quad)\x2
yy1.i=quad(voisin(i)\quad)\y1
yy2.i=quad(voisin(i)\quad)\y2
If y1=yy2 ;si quad en diagonal
If x1=xx2
voisin(i)\gate_X=x1
voisin(i)\gate_Y=y1
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
Continue
ElseIf x2=xx1
voisin(i)\gate_X=x2
voisin(i)\gate_Y=y1
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
Continue
EndIf
EndIf
If y2=yy1 ;si quad en diagonal
If x1=xx2
voisin(i)\gate_X=x1
voisin(i)\gate_Y=y2
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
Continue
ElseIf x2=xx1
voisin(i)\gate_X=x2
voisin(i)\gate_Y=y2
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
Continue
EndIf
EndIf
If y1=yy2 ;si le voisin est au dessus
If x1<xx1:x1=xx1:EndIf
If x2>xx2:x2=xx2:EndIf
voisin(i)\gate_X=x1+(x2-x1)>>1
voisin(i)\gate_Y=y1
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
Continue
EndIf
If y2=yy1 ;si le voisin est au dessous
If x1<xx1:Swap x1,xx1:EndIf;ok
If x2>xx2:Swap x2,xx2:EndIf;ok
voisin(i)\gate_X=x1+((x2-x1)>>1)
voisin(i)\gate_Y=y2
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
Continue
EndIf
If x2=xx1 ;si le voisin est a droite
If y1<yy1:Swap y1,yy1:EndIf
If y2>yy2:Swap y2,yy2:EndIf
voisin(i)\gate_X=x2
voisin(i)\gate_Y=y1+Int((y2-y1)/2)
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
Continue
EndIf
If x1=xx2 ;si le voisin est a gauche
If y1<yy1:Swap y1,yy1:EndIf
If y2>yy2:Swap y2,yy2:EndIf
voisin(i)\gate_X=x1
voisin(i)\gate_Y=y1+Int((y2-y1)/2)
jeu(voisin(i)\gate_X,voisin(i)\gate_Y)\couleur=RGB(255,0,0)
EndIf
Next i
EndProcedure
Procedure agglomerer(t.i)
;*****************************en haut
ClearList(liste())
x1=quad(t)\x1
x2=quad(t)\x2
y1=quad(t)\y1
y2=quad(t)\y2
dx=x2-x1
dy=y2-y1
ddy=#hauteur ;hauteur mini
For i=quad(t)\voisin1 To quad(t)\voisin2
c=voisin(i)\quad
If c>feuille Or quad(c)\warning:Continue:EndIf ;si un des voisins pointe vers un quad effacé, passer au voisin suivant
xx1=quad(c)\x1
xx2=quad(c)\x2
yy1=quad(c)\y1
yy2=quad(c)\y2
dxx=xx2-xx1
dyy=yy2-yy1
; si le quad a est plus(ou aussi) large que haut
; si on est au dessus du quad a
If y1<>yy2 Or (dx<dy And skip=0):Continue:EndIf
If xx1=x1;si on est aligné coté gauche
debut=1:zx=xx1
EndIf
If debut ;si on est aligné du coté gauche
If zx=xx1 ;si on est contigu cad pas d'obstable au milieu
zx=xx2
AddElement(liste()) ;on rajoute un element à la liste des voisins concernés
liste()\quad=voisin(i)\quad
If ddy>dyy:ddy=dyy:EndIf ;recherche le plus petit voisin en hauteur
If xx2=x2
debut=0:zx=0
quad(t)\y1-ddy;agrandi le quad a de la taille du plus petit voisin
ForEach liste()
d=liste()\quad
quad(d)\y2-ddy ;diminue les voisins du dessus
If quad(d)\y2=quad(d)\y1 ;si le quad disparait, le supprimer
Swap quad(d)\x1,quad(feuille)\x1
Swap quad(d)\x2,quad(feuille)\x2
Swap quad(d)\y1,quad(feuille)\y1
Swap quad(d)\y2,quad(feuille)\y2
Swap quad(d)\couleur,quad(feuille)\couleur
Swap quad(d)\warning,quad(feuille)\warning
quad(d)\warning=1
feuille-1:elimine+1
EndIf
Next
ReDim quad(feuille)
Break
EndIf
Else ;on a un obstacle...
ClearList(liste())
debut=0:zx=0
Break
EndIf
EndIf
Next i
EndProcedure
Macro tableau_tours
;tableau composé de cercles concentriques pavant la surface
; algo de tracé de cercle d'Andres
g=1
For r=1 To 100
tour(r)=g:X=0:Y=r:d=r-1
While Y>=X
matrice(g)\X=X:matrice(g)\Y=Y
g+1
matrice(g)\X=Y:matrice(g)\Y=X
g+1
matrice(g)\X=-X:matrice(g)\Y=Y
g+1
matrice(g)\X=-Y:matrice(g)\Y=X
g+1
matrice(g)\X=X:matrice(g)\Y=-Y
g+1
matrice(g)\X=Y:matrice(g)\Y=-X
g+1
matrice(g)\X=-X:matrice(g)\Y=-Y
g+1
matrice(g)\X=-Y:matrice(g)\Y=-X
g+1
If d>=(2*X)
d=d-2*X-1
X=X+1
ElseIf d<=(2*(r-Y))
d=d+2*Y-1
Y=Y-1
Else
d=d+2*(Y-X-1)
Y=Y-1
X=X+1
EndIf
Wend
Next r
EndMacro
tableau_tours
Macro arbre
For i=501 To 505
Repeat
X=Random(#largeur-10)
Y=Random(#hauteur-10)
Until jeu(X,Y)\element=0
jeu(X,Y)\element=1
jeu(X,Y)\couleur=RGB(0,255,0)
Next i
EndMacro
arbre
aire$=Str((#largeur+1)*(#hauteur+1))
GrabSprite(1,0,0,#largeur+1,#hauteur+1)
passe.i=0
affiche.b=1
Repeat
FlipBuffers()
ClearScreen(0)
If affiche=0:DisplaySprite(1,0,0):EndIf
ExamineKeyboard()
ExamineMouse()
Macro Affiche_la_carte
If affiche
If StartDrawing(ScreenOutput())
For X=0 To #largeur
For Y=0 To #hauteur
If jeu(X,Y)\element
Plot(X,Y,RGB(0,255,0))
Else
Plot(X,Y,jeu(X,Y)\couleur)
EndIf
Next Y
Next X
StopDrawing()
EndIf
EndIf
;affiche les infos de debuggage
If Val(FormatDate("%ss", Date()))=sek
FPS+1
Else
FPS$=Str(FPS)
FPS=0
EndIf
sek=Val(FormatDate("%ss", Date()))
temp=1
If StartDrawing(ScreenOutput())
DrawText(1000,temp,"truc$: "+truc$,RGB(255,255,255)):temp+15
DrawText(1000,temp,"FPS: "+FPS$,RGB(255,255,255)):temp+15
DrawText(1000,temp,"aire de jeu: "+aire$+" cases",RGB(255,255,255)):temp+15
DrawText(1000,temp,"nombre de zones: "+Str(feuille),RGB(255,255,255)):temp+15
DrawText(1000,temp,Str(Total_quad_supprime)+" quads suprimés en "+Str(passe)+" passes",RGB(255,255,255)):temp+15
DrawText(1000,temp,Str(elimine)+" quads suprimés cette passe",RGB(255,255,255)):temp+15
DrawText(1000,temp,"nombre de voisins: "+Str(vois),RGB(255,255,255)):temp+30
DrawText(1000,temp,"X, Y : "+Str(X)+ ","+Str(Y),RGB(255,255,255)):temp+15
If a> feuille:Continue:EndIf
If a
DrawText(1000,temp,"x1,y1: "+Str(quad(a)\x1)+","+Str(quad(a)\y1),RGB(255,255,255)):temp+15
DrawText(1000,temp,"x2,y2: "+Str(quad(a)\x2)+","+Str(quad(a)\y2),RGB(255,255,255)):temp+15
DrawText(1000,temp,"Quad: "+Str(a),RGB(255,255,255)):temp+15
DrawText(1000,temp,"Delta: "+Str(quad(a)\voisin2-quad(a)\voisin1+1),RGB(255,255,255)):temp+15
For i=quad(a)\voisin1 To quad(a)\voisin2
DrawText(1000,temp,"Gate : "+Str(voisin(i)\gate_X)+","+Str(voisin(i)\gate_Y)+" quad:"+Str(voisin(i)\quad),RGB(255,255,255)):temp+15
Next i
EndIf
StopDrawing()
EndIf
If affiche
GrabSprite(1,0,0,#largeur+1,#hauteur+1)
affiche=0
EndIf
EndMacro
Affiche_la_carte
X=MouseX():Y=MouseY()
DisplayTransparentSprite(0,X,Y)
;partage en quadtree l'image sans reduire le nombre de quad
If KeyboardReleased(#PB_Key_1)
affiche=1
elimine.i=0
Total_quad_supprime.i=0
passe=0
Macro Touche_1
feuille=0
eclater(0,0,#largeur,#hauteur)
;passe en revu tous les quads et les sauvegardes dans le tableau de jeu
For k=1 To feuille
For i=quad(k)\x1 To quad(k)\x2
For j=quad(k)\y1 To quad(k)\y2
jeu(i,j)\quad=k
jeu(i,j)\couleur=0
If i=quad(k)\x1 Or i=quad(k)\x2 Or j=quad(k)\y1 Or j=quad(k)\y2;si on est en bord, on encadre en couleur le quad
jeu(i,j)\couleur=quad(k)\couleur
EndIf
Next j
Next i
Next k
vois=0
;passe en revu tous les quads et trie leurs voisins
For k=1 To feuille
voisiner(k)
Next k
;affiche toutes les gates
For k=1 To feuille
For t=quad(k)\voisin1 To quad(k)\voisin2
i=voisin(t)\gate_X
j=voisin(t)\gate_Y
jeu(i,j)\couleur=RGB(255,0,0)
Next t
Next k
test2$=Str(vois)
test$=Str(feuille)
tret=1
EndMacro
Touche_1
EndIf
quad$="0"
quad1$="0"
quad2$="0"
quad$="0"
quad4$="0"
;affiche le quad sous la souris
If X>0 And Y>0 And X<#largeur And Y<#hauteur
a=jeu(X,Y)\quad
If a<=feuille
quad$=Str(a)
quad1$=Str(quad(a)\x1)
quad2$=Str(quad(a)\y1)
quad$=Str(quad(a)\x2)
quad4$=Str(quad(a)\y2)
Else
quad$="quad plus grand qu'autorisé!!!!!"
EndIf
EndIf
;affiche les gates de tous les quad
If KeyboardReleased(#PB_Key_3)
affiche=1
Macro Touche_3
For k=1 To feuille
gate(k)
Next k
EndMacro
Touche_3
EndIf
;agglomere les quads restants
If KeyboardReleased(#PB_Key_5)
affiche=1:skip=1
Macro Touche_5
;For a=1 To feuille
agglomerer(a)
;Next a
;passe en revu tous les quads et les sauvegardes dans le tableau de jeu
For k=1 To feuille
For i=quad(k)\x1 To quad(k)\x2
For j=quad(k)\y1 To quad(k)\y2
jeu(i,j)\quad=k
jeu(i,j)\couleur=0
If i=quad(k)\x1 Or i=quad(k)\x2 Or j=quad(k)\y1 Or j=quad(k)\y2;si on est en bord, on encadre en couleur le quad
jeu(i,j)\couleur=quad(k)\couleur
EndIf
Next j
Next i
Next k
vois=0:ReDim voisin(1)
;passe en revu tous les quads et recherche leurs voisins
For k=1 To feuille
quad(k)\warning=0
quad(k)\voisin1=0:quad(k)\voisin2=0
voisiner(k)
Next k
EndMacro
Touche_5
EndIf
Until KeyboardPushed(#PB_Key_Escape)