[RESOLU] FlipBuffers() can't be called inside a StartDrawin

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

[RESOLU] FlipBuffers() can't be called inside a StartDrawin

Message par Fig »

)/StopDrawing() block.

Bonjour, :mrgreen:

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. :arrow: C'est là que le problème survient .

Je tourne sur mon portable 4go, T1400, win7(32bts ed. integrale) et pb 4.41(x86)

Merci pour votre analyse et votre sagacité... :idea:

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)
Dernière modification par Fig le jeu. 25/févr./2010 14:31, modifié 1 fois.
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par djes »

Je ne comprends rien à ton bazar mais bon, v'là :

Code : Tout sélectionner

  ;constantes
  #res_X=1024 ; 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

  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
 



  ;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
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 reduire(i.i)
  For j=quad(i)\voisin1 To quad(i)\voisin2
    c=voisin(j)\quad:If c>feuille:Continue:EndIf
    If quad(c)\warning=1:Continue:EndIf
    ;si il est a droite
    If quad(i)\x2=quad(c)\x1 And quad(i)\y1=quad(c)\y1 And quad(i)\y2=quad(c)\y2
      quad(i)\x2=quad(c)\x2
      quad(c)\warning=1
      Swap quad(c)\x1,quad(feuille)\x1
      Swap quad(c)\x2,quad(feuille)\x2
      Swap quad(c)\y1,quad(feuille)\y1
      Swap quad(c)\y2,quad(feuille)\y2
      Swap quad(c)\couleur,quad(feuille)\couleur
      feuille-1
      elimine+1:Continue
    EndIf
    ;si il est a gauche
    If quad(i)\x1=quad(c)\x2 And quad(i)\y1=quad(c)\y1 And quad(i)\y2=quad(c)\y2
      quad(i)\x1=quad(c)\x1
      quad(c)\warning=1
      Swap quad(c)\x1,quad(feuille)\x1
      Swap quad(c)\x2,quad(feuille)\x2
      Swap quad(c)\y1,quad(feuille)\y1
      Swap quad(c)\y2,quad(feuille)\y2
      Swap quad(c)\couleur,quad(feuille)\couleur
      feuille-1
      elimine+1:Continue
    EndIf
    ;si il est en haut
    If quad(i)\y1=quad(c)\y2 And quad(i)\x1=quad(c)\x1 And quad(i)\x2=quad(c)\x2
      quad(i)\y1=quad(c)\y1
      quad(c)\warning=1
      Swap quad(c)\x1,quad(feuille)\x1
      Swap quad(c)\x2,quad(feuille)\x2
      Swap quad(c)\y1,quad(feuille)\y1
      Swap quad(c)\y2,quad(feuille)\y2
      Swap quad(c)\couleur,quad(feuille)\couleur
      feuille-1
      elimine+1:Continue
    EndIf
    ;si il est en bas
    If quad(i)\y2=quad(c)\y1 And quad(i)\x1=quad(c)\x1 And quad(i)\x2=quad(c)\x2
      quad(i)\y2=quad(c)\y2
      quad(c)\warning=1
      Swap quad(c)\x1,quad(feuille)\x1
      Swap quad(c)\x2,quad(feuille)\x2
      Swap quad(c)\y1,quad(feuille)\y1
      Swap quad(c)\y2,quad(feuille)\y2
      Swap quad(c)\couleur,quad(feuille)\couleur
      feuille-1
      elimine+1
    EndIf
  Next j
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

  ;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

  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
 
  ro=20
  ;créé les arbres en bosqués
  For i=1 To 0
    xTemp=Random(#largeur-10):yTemp=Random(#hauteur-10)
    For t=0 To tour(ro)-1
      itemp+1
      tempx=xTemp+matrice(t)\X
      tempy=yTemp+matrice(t)\Y
      If tempx>0 And tempy>0 And tempx<=#largeur And tempy<=#hauteur And Random(10)<4
        jeu(tempx,tempy)\couleur=RGB(0,255,0)
        jeu(tempx,tempy)\element=1
      EndIf
    Next t
  Next i

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()
 
    If affiche
       If StartDrawing(ScreenOutput())
        For X=0 To #largeur-1
          For Y=0 To #hauteur-1
            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(#res_X-256,temp,"truc$: "+truc$,RGB(255,255,255)):temp+15

      DrawText(#res_X-256,temp,"FPS: "+FPS$,RGB(255,255,255)):temp+15
      DrawText(#res_X-256,temp,"aire de jeu: "+aire$+" cases",RGB(255,255,255)):temp+15
      DrawText(#res_X-256,temp,"nombre de zones: "+Str(feuille),RGB(255,255,255)):temp+15
      DrawText(#res_X-256,temp,Str(Total_quad_supprime)+" quads suprimés en "+Str(passe)+" passes",RGB(255,255,255)):temp+15
      DrawText(#res_X-256,temp,Str(elimine)+" quads suprimés cette passe",RGB(255,255,255)):temp+15
      DrawText(#res_X-256,temp,"nombre de voisins: "+Str(vois),RGB(255,255,255)):temp+30
      DrawText(#res_X-256,temp,"X, Y  : "+Str(X)+ ","+Str(Y),RGB(255,255,255)):temp+15
      If a> feuille:Continue:EndIf
      If a
        DrawText(#res_X-256,temp,"x1,y1: "+Str(quad(a)\x1)+","+Str(quad(a)\y1),RGB(255,255,255)):temp+15
        DrawText(#res_X-256,temp,"x2,y2: "+Str(quad(a)\x2)+","+Str(quad(a)\y2),RGB(255,255,255)):temp+15
        DrawText(#res_X-256,temp,"Quad: "+Str(a),RGB(255,255,255)):temp+15
        DrawText(#res_X-256,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(#res_X-256,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
 
  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
      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-1
          For j=quad(k)\y1 To quad(k)\y2-1
            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-1
          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
  EndIf
 
  ;Réduit le nombre de quad une seule fois.
  If KeyboardReleased(#PB_Key_2) And tret=1
    affiche=1
      passe+1
      elimine.i=0
      ;passe en revu les quads et leurs voisins et les regroupe par taille
      For i=1 To feuille
        reduire(i)
      Next i
      Total_quad_supprime+elimine
     
      ;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-1
          For j=quad(k)\y1 To quad(k)\y2-1
            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
        ;quad(k)\x1=0:quad(k)\y1=0
        ;quad(k)\x2=0:quad(k)\y2=0
        voisiner(k)
      Next k
      ReDim quad(feuille);on réduit le tableau
      test2$=Str(vois)
      test$=Str(feuille)
     
  EndIf
 
  ;rajoute un batiment/obstacle
  If MouseButton(#PB_MouseButton_Left)
    affiche=1
    b=Random(5)+2
    For i=1 To b
      For j=1 To b
        If X+i>0 And Y+j>0 And X+i<#largeur And Y+j<#hauteur
          jeu(X+i,Y+j)\element=1
        EndIf
      Next j
    Next i
  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 que autorisé!!!!!"
    EndIf
  EndIf
 
 
  ;affiche les gates de tous les quad
  If KeyboardReleased(#PB_Key_3)
    affiche=1
      For k=1 To feuille
        gate(k)
      Next k
  EndIf
 
  ;affiche les gates du quad sous la souris
  If KeyboardReleased(#PB_Key_4)
    affiche=1:skip=0
      gate(a)
  EndIf
 
  ;agglomere les quads restants
  If KeyboardReleased(#PB_Key_5)
    affiche=1:skip=1
    ;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-1
          For j=quad(k)\y1 To quad(k)\y2-1
            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
     
     
  EndIf
  Until KeyboardReleased(#PB_Key_Escape)
Au passage j'ai viré les macros; si tu veux avoir des raccourcis dans le menu de droite tu peux faire

Code : Tout sélectionner

;- Mon beau raccourci
ou

Code : Tout sélectionner

;{mon beau code pliable
;}
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par Fig »

Voui, je ne connaissais pas pour le code pliable... Merci :oops:

Est ce que par hasard tu as trouvé ce qui ne va pas ?
Je ne comprends rien à ton bazar mais bon, v'là :
Par où commencer...
c'est un prog de test permettant (qui permettrai je mets le conditionnel arf :mrgreen: ) un pathfinding très rapide sur un carte de rts (très) vaste...

Je préprocess d'abord la carte en traitant tous les éléments fixes (cad tout sauf les unités).
Le prog partage la carte en quadtree de façon récursive (procédure eclater) et sauvegarde les coordonnées de chaque carré dans quad()\x1,x2,y1,y2
Ensuite la procédure voisiner() cherche tous les voisins de chacun des quads créés.
Ensuite, je regroupe les quad ensemble pour former des zones les plus vaste possible.
enfin, je recherche les "gates" de chacun des quads avec ses voisins... cad un point de jonction avec eux (touche 3, procédure gate())

Bref, au lieu de faire un pathfinding sur chaque case, je le fais que sur les zones. Ensuite j'obtiens un chemin valide puis je le traite pour avoir une courbe harmonieuse.
=>Si je rencontre un obstacle mouvant, j'attends qu'il soit sorti de la trajectoire ou je le fais se déplacer sur une case vide adjacente (cas d'une unité amie).
=> Si je rencontre une unité mais qui est fixe, si elle est amie, je la fais se déplacer, sinon je recalcule le chemin en tenant compte du champ de répulsion de l'unité rencontrée.
=>Si je me déplace dans une seule et même zone, pas de pathfinding, une simple droite suffit.
=> en cas de création de batiment ou d'abattage d'arbre, je re-subdivise uniquement la zone concerné avec le processus déja mentionné.

Bon, quand ce sera fini, on en reparlera arf, je ne suis jamais pressé... :roll:
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par Fig »

Ca ne marche pas mieux, même erreur.... :cry:

A quoi cela peut il être dû ??? (ne me répondez pas: au programmeur, de grâce.. :mrgreen: )
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par djes »

Ok, je comprends mieux. Ca ressemble à un débordement de pile, ça arrive souvent avec des procédures récursives. Je vais enquêter ;)
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par Fig »

Ma procédure récursive de partage en quadtree s'exécute sans message d'erreur... Donc, une fois fini, tous les retours de procédures qui ont été empilés, ont été dépilés normalement (?) => pile nickel.
J'utilise pas mal les break et continue... mais j'imagine que ça sort proprement des boucles, vu que c'est fait pour...
Sinon dans le genre utilisation d'instructions louches, je redimensionne souvent quad() et voisin()...

Déjà, est ce que tu rencontre l'erreur (non systématique) que je rencontre ? (touche 1 puis touche 5 plusieurs fois sur un grand quad...=> erreur ...parfois)

Merci beaucoup, je me sens moins seul :wink:
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par djes »

Oui, je l'ai eu. Normalement il ne devrait pas y avoir de problème de pile, mais... c'est sûrement ça (désolé, c'est l'expérience qui me le dit, ça vaut ce que ça vaut!).
Il faudra trouver un moyen de déclencher le bug systématiquement.
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par djes »

C'est pas évident, d'autant que je ne le sens pas trop, ce code; j'ai l'impression qu'il y a plein de dépassements d'index dans les tableaux. En modifiant comme suit, j'ai encore le bug, plus d'autres qui apparaissent quand on appuie sur '3'.

Edit : je me suis trompé de code ;)
Dernière modification par djes le jeu. 25/févr./2010 16:14, modifié 1 fois.
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par Fig »

:) oui, je sais pour les dépassements d'index dans les tableaux... En fait, quand un quad est éliminé, il est remplacé par un autre et on diminue la taille du tableau de 1.
Le problème c'est qu'il y a encore plein de voisin qui pointent vers ce quad dont la valeur à changée... donc je le mets en warning, je le traite à la passe suivante quand les voisins sont mis à jour...
Effectivement c'est sans aucun doute bancal, je vais reprendre tout ça, d'autant que le temps de traitement n'est pas important vu que ca sera exécuté avant la boucle principale...

Bon, ça n'explique pas ce problème mais je vais tout reprendre à zéro...
C'est vrai que de toute manière le code n'était pas fonctionnel ni achevé en état.

En tout cas, je te remercie d'avoir pris la peine de plonger dans ce truc peu ragoutant :mrgreen:

Je te dispense d'aller plus loin :wink:

Merci encore une fois. :idea:


Ps: je pense que tu n'as pas posté le bon code non ?? je ne vois pas le rapport... (enfin, si ce n'est que ce code est tout propre :oops: )
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: [ERROR] FlipBuffers() can't be called inside a StartDrawing(

Message par Fig »

Ca y est j'ai trouvé (enfin je crois) arf !!! C'était simple, une erreur d'inattention. :!:
Cette ligne dans la zone d'affichage des infos de debuggage:
If a> feuille:continue:EndIf
Or, il ne peut rien continuer du tout vu qu'il n'est pas dans une boucle. :mrgreen:

'suis con :roll:


Désolé pour le tracas, Djes. :oops: :oops:

Je vous tiens au courant quand (si un jour) ça marche @+ et merci encore.
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: [RESOLU] FlipBuffers() can't be called inside a StartDrawin

Message par djes »

C'est rien, c'est très intéressant ce que tu essayes de faire! Tiens-nous au courant de tes avancées :)
Répondre