PureBasic

Coucou,

Je ne savais pas vraiment où poster ça (Jeux? pas forcement un rapport avec, Application? pas fait spécialement pour, Bug? je sais pas si c'est un bug.... bref) donc je le post ici.

J'ai repris le code de comtois sur le pathfinding afin de calculer la position d'une "entitée" parcourant le chemin dans un Thread. Pour un petit trajet, pas de problème mais lorsque ça devient plus long, ça plante (pas de message d'erreur de pb, seulement un "PureBasicxxxx a rencontré un problème et doit fermer... et blablabla) mais pas a tout les coups...

Bref ça à l'air d'ètre un beau truc tordus que je n'arrive pas a résoudre...
Voilas le code :

Code : Tout sélectionner

; reprise du code de comtois

Structure NodeInfos
  IsOpen.b
  IsClosed.b
  f.l
  G.l
  h.l
  Parent.POINT
EndStructure

Structure Way
  *StartWay.POINT
  *EndWay.POINT
  ThID.l
EndStructure

Structure EntityInfo
  IsMoving.b
  x.l
  y.l
  Way.Way
EndStructure

Declare FindWay(*StartWay.POINT, *EndWay.POINT)
Declare RunWay(*PtEntity.EntityInfo)
Declare Average(x1, y1, x2, y2, Value)

Entity.EntityInfo

#max_x = 32
#max_y = 24
#Speed = 5

InitSprite()

OpenWindow(0, 0, 0, #max_x * 32 + 32, #max_y * 32 + 32, #PB_Window_ScreenCentered | #PB_Window_SystemMenu, "pathfinding")
OpenWindowedScreen(WindowID(), 0, 0, #max_x * 32 + 32, #max_y * 32 + 32, 0, 0, 0)
AddKeyboardShortcut(0, #PB_Shortcut_Back, 0)
AddKeyboardShortcut(0, #PB_Shortcut_S, 1)
AddKeyboardShortcut(0, #PB_Shortcut_E, 2)

Cursor.POINT

Cases.POINT
StartPos.POINT
EndPos.POINT

Dim Map(#max_x, #max_y)
Dim Node.NodeInfos(#max_x, #max_y)

For t = 0 To 100
  Map(Random(#max_x), Random(#max_y)) = 1
Next

For xm = 0 To #max_x
  For ym = 0 To #max_y
    ok = 0
    For xm2 = xm - 1 To xm + 1
      For ym2 = ym - 1 To ym + 1
        If xm2 >= 0 And xm2 <= #max_x And ym2 >= 0 And ym2 <= #max_y
          If Map(xm2, ym2) = 0
            ok + 1
          EndIf
        EndIf
      Next
    Next
    If ok  = 8
      Map(xm, ym) = 1
    EndIf
  Next
Next

StartPos\x = Random(#max_x-1) : StartPos\y = Random(#max_y-1)
EndPos\x   = Random(#max_x-1) : EndPos\y   = Random(#max_y-1)

Repeat
  
  GetCursorPos_(@Cursor)
  Cursor\x - WindowX()
  Cursor\y - WindowY() - 28
  Cases\x = Cursor\x / 32
  Cases\y = Cursor\y / 32
  If Cases\x < 0 : Cases\x = 0 : EndIf : If Cases\y < 0 : Cases\y = 0 : EndIf
  If Cases\x > #max_x : Cases\x = #max_x : EndIf : If Cases\y > #max_y : Cases\y = #max_y : EndIf
  
  Select WindowEvent()
    Case #PB_Event_Menu
      Select EventMenuID()
        Case 0
          Map(Cases\x, Cases\y) = 0
          
        Case 1
          StartPos\x = Cases\x
          StartPos\y = Cases\y
          
        Case 2
          EndPos\x = Cases\x
          EndPos\y = Cases\y
      EndSelect
      
    Case #WM_CLOSE
      Quit = #True
      
    Case #WM_LBUTTONDOWN
      FillMap = #True
      
    Case #WM_LBUTTONUP
      FillMap = #False
      
    Case #WM_RBUTTONUP
      ; si on trouve un chemin...
      If FindWay(@StartPos, @EndPos) = #True
        ; si il y a un thread en cour, on le kill
        If Entity\Way\ThID <> 0
          KillThread(Entity\Way\ThID)
        EndIf
        
        ; on creer un thread pour calculer la position de l'entity parcourant le chemin
        Entity\Way\StartWay = @StartPos
        Entity\Way\EndWay = @EndPos
        Entity\Way\ThID = CreateThread(@RunWay(), @Entity)
      EndIf
      
  EndSelect
  
  If FillMap = #True
    Map(Cases\x, Cases\y) = 1
  EndIf
  
  
  ; dessine le bazard
  ClearScreen(232, 232, 165)
  
  StartDrawing(ScreenOutput())
  
  If Entity\IsMoving = #True
    DrawingMode(0)
    Circle(Entity\x, Entity\y, 16, #Yellow)
  EndIf
  
  For xm = 0 To #max_x
    For ym = 0 To #max_y
      DrawingMode(4)
      Box(xm * 32, ym * 32, 32, 32, #Gray)
      DrawingMode(0)
      If Map(xm, ym) = 1
        Box(xm * 32, ym * 32, 32, 32, #Blue)
      EndIf
    Next
  Next
  
  DrawingMode(0)
  Circle(StartPos\x * 32 + 16, StartPos\y * 32 + 16, 16, #Green)
  Circle(EndPos\x * 32 + 16  , EndPos\y * 32 + 16  , 16, #Red)
  
  DrawingMode(4)
  Box(Cases\x * 32 - 1, Cases\y * 32 - 1, 34, 34, #Red)
  Box(Cases\x * 32    , Cases\y * 32    , 32, 32, #Red)
  Box(Cases\x * 32 + 1, Cases\y * 32 + 1, 30, 30, #Red)
  StopDrawing()
  
  FlipBuffers()
  
Until Quit = #True

Procedure RunWay(*PtEntity.EntityInfo)
  ; 'trace' le chemin
  
  CurrentNode.POINT ; noeud courant
  NextNode.POINT ; prochain noeud
  
  ; on initialise le bazard
  CurrentNode\x = *PtEntity\Way\StartWay\x
  CurrentNode\y = *PtEntity\Way\StartWay\y
  NextNode\x = Node(CurrentNode\x, CurrentNode\y)\Parent\x
  NextNode\y = Node(CurrentNode\x, CurrentNode\y)\Parent\y
  *PtEntity\x = CurrentNode\x * 32 + 16
  *PtEntity\y = CurrentNode\y * 32 + 16
  
  *PtEntity\IsMoving = #True
  
  Repeat
    
    Repeat
      
      ; on deplace l'entity en fonction du noeud courant et suivant
      If CurrentNode\x < NextNode\x And CurrentNode\y = NextNode\y
        *PtEntity\x + #Speed
      ElseIf CurrentNode\x > NextNode\x And CurrentNode\y = NextNode\y
        *PtEntity\x - #Speed
      ElseIf CurrentNode\x = NextNode\x And CurrentNode\y < NextNode\y
        *PtEntity\y + #Speed
      ElseIf CurrentNode\x = NextNode\x And CurrentNode\y > NextNode\y
        *PtEntity\y - #Speed
      ElseIf CurrentNode\x < NextNode\x And CurrentNode\y < NextNode\y
        *PtEntity\x + #Speed
        *PtEntity\y + #Speed
      ElseIf CurrentNode\x < NextNode\x And CurrentNode\y > NextNode\y
        *PtEntity\x + #Speed
        *PtEntity\y - #Speed
      ElseIf CurrentNode\x > NextNode\x And CurrentNode\y < NextNode\y
        *PtEntity\x - #Speed
        *PtEntity\y + #Speed
      ElseIf CurrentNode\x > NextNode\x And CurrentNode\y > NextNode\y
        *PtEntity\x - #Speed
        *PtEntity\y - #Speed
      EndIf
      
      ; obliger, sinon c'est trop rapide!!!
      Delay(30)
      
      ; si la position de l'entity est 'a peut pret' a la position du noeud suivant
    Until Average(*PtEntity\x, *PtEntity\y, NextNode\x * 32 + 16, NextNode\y * 32 + 16, #Speed + 1)
    
    ; on passe au noeud suivant
    CurrentNode\x = NextNode\x
    CurrentNode\y = NextNode\y
    NextNode\x = Node(CurrentNode\x, CurrentNode\y)\Parent\x
    NextNode\y = Node(CurrentNode\x, CurrentNode\y)\Parent\y
    *PtEntity\x = CurrentNode\x * 32 + 16
    *PtEntity\y = CurrentNode\y * 32 + 16
    
    ; si le noeud courant est le noeud de fin du chemin, le parcours est terminé
  Until CurrentNode\x = *PtEntity\Way\EndWay\x And CurrentNode\y = *PtEntity\Way\EndWay\y
  
  *PtEntity\IsMoving = #False
  ToKill = *PtEntity\Way\ThID
  *PtEntity\Way\ThID = 0
  KillThread(ToKill)
  
EndProcedure

Procedure Average(x1, y1, x2, y2, Value)
  If Abs(x1 - x2) <= Value And Abs(y1 - y2) <= Value
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure FindWay(*StartWay.POINT, *EndWay.POINT)
  ; repris du code de comtois, voir son poste pour plus d'infos
  For xw = 0 To #max_x 
    For yw = 0 To #max_y 
      Node(xw, yw)\IsOpen = #False
      Node(xw, yw)\IsClosed = #False
      Node(xw, yw)\f = 0
      Node(xw, yw)\G = 0
      Node(xw, yw)\h = 0
      Node(xw, yw)\Parent\x = 0
      Node(xw, yw)\Parent\y = 0
    Next yw
  Next xw
  
  If (*StartWay\x = *EndWay\x And *StartWay\y = *EndWay\y) Or (Map(*StartWay\x, *StartWay\y) = 1) Or (Map(*EndWay\x, *EndWay\y) = 1)
    WayType = -1
  EndIf 
  
  Node(*EndWay\x, *EndWay\y)\IsOpen = #True
  
  Node(*EndWay\x, *EndWay\y)\f = -1
  
  While WayType = 0 
    MinF = 0 
    For xw = 0 To #max_x
      For yw = 0 To #max_y 
        
        If  Node(xw, yw)\IsOpen = #True And Node(xw, yw)\IsClosed = #False And (Node(xw, yw)\f < MinF Or MinF = 0)
          
          MinF = Node(xw, yw)\f
          
          nx = xw
          ny = yw
        EndIf 
      Next yw
    Next xw
    
    If MinF = 0 
      WayType = -1
    EndIf 
    
    Node(nx, ny)\IsClosed = #True
    
    If WayType = 0 
      For xw = nx - 1 To nx + 1 
        For yw = ny - 1 To ny + 1 
          If xw >= 0 And xw <= #max_x And yw >= 0 And yw <= #max_y 
            If Map(xw, yw) = 0 And Node(xw, yw)\IsClosed = #False
              CheckWay = #True
              If xw = nx - 1 And yw = ny - 1 And Map(nx, ny - 1) = 1 And Map(nx - 1, ny) = 1 : CheckWay = #False : EndIf 
              If xw = nx - 1 And yw = ny + 1 And Map(nx, ny + 1) = 1 And Map(nx - 1, ny) = 1 : CheckWay = #False : EndIf 
              If xw = nx + 1 And yw = ny - 1 And Map(nx, ny - 1) = 1 And Map(nx + 1, ny) = 1 : CheckWay = #False : EndIf 
              If xw = nx + 1 And yw = ny + 1 And Map(nx, ny + 1) = 1 And Map(nx + 1, ny) = 1 : CheckWay = #False : EndIf 
              If CheckWay = #True 
                
                If Abs(xw - nx) > 0 And Abs(yw - ny) > 0 
                  G = Node(nx, ny)\G + 14
                Else 
                  G = Node(nx, ny)\G + 10
                EndIf 
                
                If Node(xw, yw)\IsOpen = #False Or G < Node(xw, yw)\G
                  
                  Node(xw, yw)\IsOpen = #True
                  Node(xw, yw)\Parent\x = nx
                  Node(xw, yw)\Parent\y = ny
                  
                  Node(xw, yw)\G = G
                  Node(xw, yw)\h = (Abs(*StartWay\x - xw) + Abs(*StartWay\y - yw))*10 
                  Node(xw, yw)\f = Node(xw, yw)\G + Node(xw, yw)\h
                  
                  If xw = *StartWay\x And yw = *StartWay\y 
                    WayType = 1 
                    Break 2 
                  EndIf 
                EndIf 
              EndIf 
            EndIf 
          EndIf 
        Next yw
      Next xw
    EndIf 
  Wend 
  ProcedureReturn WayType 
  
EndProcedure

Infos : a écrit : Click gauche = faire un mure
Click droit = parcourir le chemin
Retour arriere = supprimer un mur
S = changer la position de depart
E = changer la position de fin

Merci d'avance pour votre aide

PS : si ce n'est pas assez commenté, faites le moi savoir

Après plusieurs tests archarnés ce matin, se serais le debugger etant activé qui ferais planté le code. Dumoin c'est ce que j'ai remarqué, quelqu'un pourais le confirmé ?

Merci

tu m'as devancé , j'avais commencé à le reprendre entièrement ce code

Notamment cette partie

Code : Tout sélectionner

    For xw = 0 To #max_x
      For yw = 0 To #max_y
       
        If  Node(xw, yw)\IsOpen = #True And Node(xw, yw)\IsClosed = #False And (Node(xw, yw)\f < MinF Or MinF = 0)
         
          MinF = Node(xw, yw)\f
         
          nx = xw
          ny = yw
        EndIf
      Next yw
    Next xw

c'est pas une bonne idée d'explorer l'ensemble de la map .
je voulais faire des tests en triant au fur et à mesure Node(xw,yw)\f.
de cette façon , il suffit de prendre la valeur en début de liste , ça limite les tests .
imagine une map de 100x100 ,actuellement le code fait 10000 tests pour trouver le F le plus petit. Avec une liste triée , le F le plus petit se trouvera en tête de liste.
Reste à voir combien de temps prendra un tri .

Sinon j'ai testé rapidement ce matin , j'ai eu un plantage au premier coup ; mais je ne sais plus si c'était avec le débuggeur

et sans le thread ton code fonctionne ?

Ton idée de trier les F est pas mal, un quicksort devrait faire l'affaire

Sinon, oui sans le thread ça fonctionne...

effectivement , avec le debuggeur , ça plante à tous les coups .
bon je vais étudié comment tu utilises le thread , je n'en ai jamais codé , ça va être l'occasion de voir ce que ça apporte

euh , ça apporte quoi d'ailleurs ?

Pas chez moi, ça plante pas (avec et sans debugguer PB 3.92)

@Comtois : Par exemple, dans une jeux de strategie, ça evite permet de deplacer plusieur unitée en "même temps"

@Régis : Merci d'avoir essayer

Conclusion : Fred, je crois qu'on a déceler un bug dans la beta 3.93 (beta 2 pour moi, et beta 3 pour comtois il me semble...)

PureBasic

Petit problème avec les threads

Petit problème avec les threads