Pathfinding , nouvelle version

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

comtois a écrit :Je voulais surtout te donner une piste pour trouver le point le plus proche, j'ai pas pris le temps de tester et de tout vérifier, tu veux bien finir tout seul :)
Je vais essayer :P
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

tu peux modifier la procedure AffOpenClosed() pour visualiser la valeur du f.

Code : Tout sélectionner

Procedure AffOpenClosed()
    CoulOpen=RGB(200,255,200)
    CoulClosed=RGB(255,200,200)
    StartDrawing(ScreenOutput())
    For y=0 To #max_y
        For x=0 To #max_x
            xa=x*#taille
            ya=y*#taille
            Id = x + (#max_x+1)*y
            If Noeud(Id)\Closed
                Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulClosed)
            ElseIf Noeud(Id)\Open
                Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulOpen)
                EndIf
             DrawingMode(#PB_2DDrawing_Transparent)   
            DrawText(xa + 3, ya + 4, Str(Noeud(Id)\f))
        Next x
    Next y
    StopDrawing()
EndProcedure
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Finalement je me suis accordé une petite pause de 10 minutes , voici ma dernière solution et je passe à autre chose :)

Code : Tout sélectionner

; ***********************************************************
; ** Comtois le 17/07/05 - Pathfinding pour Purebasic V0.5 **
; ***********************************************************
; PB4.0

; **********************************************************************
; ************************** Mode d'emploi *****************************
; **********************************************************************
; ** Touche [F1] pour Afficher les cases Closed / Open **
; ** Touche [F2] pour Afficher le chemin **
; ** Touche [F3] Sauve la Map : Permet de faire différents tests avec la même map **
; ** Touche [F4] Charge la Map  **
; ** Touche [F5] Affiche une Grille **
; ** Touche [F6] Efface la Map **
; ** Touche [F7] Sans/Avec diagonale **
; ** Touche [F8] Sans/Avec recherche du point le plus proche si l'accès à la cible n'est pas possible **
; ** Touche [F9] Sans/Avec Remplissage >> Visualise la zone de déplacement possible à partir de Départ**
; ** Bouton Gauche de la souris ajoute un mur **
; ** Bouton Droit de la souris efface un mur **
; ** Bouton Gauche de la souris + la Touche [Shift] Déplace la cible **
; ** Bouton Droit de la souris + la touche [Shift] Déplace le départ **
; **********************************************************************


; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
    MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
    End
EndIf

; --- Plein écran ---
#ScreenWidth = 800
#ScreenHeight = 600
#ScreenDepth = 16
If OpenScreen(#ScreenWidth,#ScreenHeight,#ScreenDepth,"Essai Pathfinding") = 0
    MessageRequester("Erreur", "Impossible d'ouvrir l'écran ", 0)
    End
EndIf

; --- Variables globales ---
Global ciblex,cibley,departx,departy, AffOpenClosed,affPath,AffGrille,Chrono,ChronoMax,diagonale
Global Remplissage,Proche,LePlusProche.point,Destination.point

diagonale=1
affPath=1
AffGrille=1

; --- dimension du tableau et taille d'une case ---
#max_x=15
#max_y=15
#max_x1=#max_x+1
#taille=32


; --- positionne la cible sur la grille ---
ciblex=1+Random(#max_x-2)
cibley=1+Random(#max_y-2)

; --- positionne le départ sur la grille ---
departx=1+Random(#max_x-2)
departy=1+Random(#max_y-2)

Structure Noeud
    Id.l
    x.l
    y.l
    f.l
    G.l
    H.l
    Open.l
    Closed.l
EndStructure   
 
; --- pour la recherche du chemin ---
Global Dim map(#max_x,#max_y)
Global Dim MapTest(#max_x,#max_y)
Global Dim parent.Point(#max_x,#max_y)
Global Dim Tas((#max_x+1)*(#max_y+1))
Global Dim Noeud.Noeud((#max_x+1)*(#max_y+1))

; ************************************************************************************
; *** LES SPRITES ***
; ************************************************************************************
Enumeration
    #depart
    #cible
    #Souris
EndEnumeration

;/Départ
CreateSprite(#depart, #taille, #taille)
StartDrawing(SpriteOutput(#depart))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,255,15))
StopDrawing()
;/Cible
CreateSprite(#cible, #taille, #taille)
StartDrawing(SpriteOutput(#cible))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,55,15))
StopDrawing()
;/ Souris
CreateSprite(#Souris, #taille, #taille)
StartDrawing(SpriteOutput(#Souris))
DrawingMode(4)
Box(1,1,#taille-1,#taille-1,RGB(100,200,255))
StopDrawing()

; ************************************************************************************
; *** LES PROCEDURES ***
; ************************************************************************************
Procedure SauveMap()
    If CreateFile(0,"PathFindingMap.map")
        WriteLong(0,ciblex)
        WriteLong(0,cibley)
        WriteLong(0,departx)
        WriteLong(0,departy)
       
        For y=0 To #max_y
            For x=0 To #max_x
                WriteLong(0,map(x,y))
            Next x
        Next y
        CloseFile(0)
    EndIf   
EndProcedure
Procedure ChargeMap()
    If OpenFile(0,"PathFindingMap.map")
        ciblex=ReadLong(0)
        cibley=ReadLong(0)
        departx=ReadLong(0)
        departy=ReadLong(0)
        For y=0 To #max_y
            For x=0 To #max_x
                map(x,y) = ReadLong(0)
            Next x
        Next y
        CloseFile(0)
    EndIf   
EndProcedure

Procedure mur()
    Couleur=RGB(100,100,255)
    StartDrawing(ScreenOutput())
    For y=0 To #max_y
        For x=0 To #max_x
            If map(x,y)
                Box(x*#taille + 1,y*#taille + 1,#taille - 1,#taille - 1,Couleur)
            EndIf
        Next x
    Next y
    DrawingMode(1)
    FrontColor(RGB(255,255,255))
    Col=0

    lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F1] Sans/Avec open et closed")
   
    lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F2] Sans/Avec Recherche")
   
    lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F3] Sauve la Map")
   
    lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F4] Charge la Map")
   
    lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F5] Sans/Avec Grille")
   
   
   lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F6] Efface la Map")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F7] Sans/Avec Diagonale : " + Str(diagonale))
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F8] Sans/Avec proche : " + Str(Proche))
     
    lig + 20
    DrawText(#taille*(#max_x+1),lig,"[Bouton Gauche] Ajoute un mur")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] Efface un mur")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[Bouton Gauche] + [Shift] Cible")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] + [Shift] Départ")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"Position : " + Str(MouseX()/#taille) + " / " + Str(MouseY()/#taille))   
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"Temps : " + Str(Chrono) + " / " + Str(ChronoMax))
   
    StopDrawing()
EndProcedure

Procedure EffaceMur()
   
    For y=0 To #max_y
        For x=0 To #max_x
            map(x,y)=0
        Next x
    Next y
   
EndProcedure
Procedure AffGrille()
    Couleur=RGB(100,100,100)
    StartDrawing(ScreenOutput())
    For x=0 To #max_x
        Line(x*#taille,0,0,(#max_y+1)*#taille,Couleur)
    Next x
    For y=0 To #max_y
        Line(0,y*#taille,(#max_x+1)* #taille,0,Couleur)
    Next y         
    StopDrawing()
EndProcedure
Procedure RetasseTas(Pos)
    M=Pos
    While M <> 1
        If Noeud(Tas(M))\f <= Noeud(Tas(M/2))\f
            temp = Tas(M/2)
            Tas(M/2) = Tas(M)
            Tas(M) = temp
            M = M/2
        Else
            Break
        EndIf
    Wend
EndProcedure

Procedure.w ChercheChemin()
    ;Debug "Dx:"+Str(departx)+" Dy:"+Str(departy)+" Cx:"+Str(ciblex)+" CY:"+Str(cibley)
    ;Initialise le tableau Noeud
    Dim Noeud.Noeud((#max_x+1)*(#max_y+1))
   
    ;Si on est déjà arrivé pas la peine d'aller plus loin
    If departx=Destination\x And departy=Destination\y
        ProcedureReturn 0
    EndIf
   
    ;Calcul Un ID unique pour le Noeud en cours
    NoeudID = departx
    NoeudID + #max_x1 * departy
   
    ; --- on met le point de départ dans le tas ---
    ;Un tas c'est un arbre , habituellement binaire.
    ;Il permet de retrouver rapidement le f le plus petit ,sans avoir à trier l'ensemble des Noeuds.
   
    Taille_Tas = 1
    Tas(Taille_Tas)=NoeudID
    Noeud(NoeudID)\x=departx
    Noeud(NoeudID)\y=departy
    Noeud(NoeudID)\Open=1
   
    ; --- tant que la liste open n'est pas vide et tant qu'on a pas trouvé la cible
    While fin = 0
        ; --- il n'y a pas de chemin ---
        If Taille_Tas = 0
            fin = 2
            Break
        Else
           
            ; --- on récupère la Case la plus avantageuse ( avec F le plus bas) ===
           
            NoeudID=Tas(1)
            x=Noeud(NoeudID)\x
            y=Noeud(NoeudID)\y
            Noeud(NoeudID)\Closed=1
           
           
            ;Supprime un noeud du tas
            Tas(1) = Tas(Taille_Tas)
            Taille_Tas - 1
           
            ;Retasse le tas après une suppression
            v = 1
           
            Repeat
                u = v
                If 2*u+1 <= Taille_Tas
                    If Noeud(Tas(u))\f >= Noeud(Tas(2*u))\f : v = 2*u   : EndIf
                    If Noeud(Tas(v))\f >= Noeud(Tas(2*u+1))\f : v = 2*u+1 : EndIf
                ElseIf 2*u <= Taille_Tas
                    If Noeud(Tas(u))\f >= Noeud(Tas(2*u))\f : v = 2*u : EndIf
                EndIf
               
                If u <> v
                    temp = Tas(u)
                    Tas(u) = Tas(v)
                    Tas(v) = temp
                Else
                    Break ; la propriété du tas est rétablie , on peut quitter
                EndIf
            ForEver
           
        EndIf
       
       
        ; --- on teste les cases autour de la case sélectionnée ===
       
        For a = x - 1 To x + 1
            For b = y - 1 To y + 1
                ;Conditions de validité d'une case
                If a >= 0 And a <= #max_x And b >= 0 And b <= #max_y And (diagonale=1 Or a = x Or b = y) And (a = x Or b = y Or map(a,y)=0 Or map(x,b)=0)
                   
                    ;Calcul un ID unique
                    TempID = a
                    TempID + #max_x1 * b
                   
                    ; ---- si la Case est libre et n'a pas encore été traitée
                    If map(a,b) = 0 And Noeud(TempID)\Closed = 0
                       
                        ; calcule G pour la Case en cours de test ( à adapter selon le jeu)
                        ; si la distance n'a pas d'importance , on peut se contenter de calculer
                        ; le nombre de cases , donc de faire G = G(x,y) + 1
                       
                        If a <> x And b <> y
                            G = 14 + Noeud(NoeudID)\G ;
                        Else
                            G = 10 + Noeud(NoeudID)\G ;
                        EndIf
                       
                       
                        ; si la Case n'est pas dans la liste open ou si est meilleur en passant par cette case
                        If Noeud(TempID)\Open = 0 Or G < Noeud(TempID)\G
                           
                            parent(a,b)\x = x
                            parent(a,b)\y = y
                            Noeud(TempID)\G = G
                            Noeud(TempID)\H = (Abs(ciblex-a) + Abs(cibley-b))*10
                            Noeud(TempID)\f = Noeud(TempID)\G + Noeud(TempID)\H
                                                       
                            If Noeud(TempID)\Open = 0
                               
                                ;Ajoute le Noeud dans le tas
                                Taille_Tas + 1
                                Tas(Taille_Tas) = TempID
                                Noeud(TempID)\x = a
                                Noeud(TempID)\y = b
                                Noeud(TempID)\Open = 1
                                Position = Taille_Tas
                               
                            Else
                               
                                ;Cherche la position du Noeud dans le tas
                                For i = 1 To Taille_Tas
                                    If Tas(i)=TempID
                                        Position = i
                                        Break
                                    EndIf
                                Next i
                               
                            EndIf
                           
                            ;Retasse le tas à partir du Noeud en cours
                            While Position <> 1
                                If Noeud(Tas(Position))\f <= Noeud(Tas(Position/2))\f
                                    temp = Tas(Position/2)
                                    Tas(Position/2) = Tas(Position)
                                    Tas(Position) = temp
                                    Position = Position/2
                                Else
                                    Break
                                EndIf
                            Wend
                           
                            ; --- la cible est trouvée ---
                            If a = Destination\x And b = Destination\y
                                fin = 1
                                Break 2
                            EndIf
                        EndIf
                    EndIf
                EndIf
            Next b
        Next a
    Wend
    ProcedureReturn fin
EndProcedure

Procedure souris(ToucheShift)
    If ExamineMouse()
        SX = MouseX() / #taille
        SY = MouseY() / #taille
        If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y
            If ToucheShift = 0
                If MouseButton(1)
                    map(SX,SY)=1 ;place un mur
                ElseIf MouseButton(2)
                    map(SX,SY)=0 ; supprime un Mur
                EndIf
            Else
                If MouseButton(1)
                  If map(SX,SY)=0
                     ciblex = SX : cibley = SY ; place la cible
                  EndIf   
                ElseIf MouseButton(2)
                  If map(SX,SY)=0
                    departx = SX : departy = SY ; place le départ
                  EndIf  
                EndIf
            EndIf
        EndIf
    EndIf
EndProcedure
Procedure AffRemplissage()
    Couleur=RGB(85,85,85)
    StartDrawing(ScreenOutput())
    For y=0 To #max_y
        For x=0 To #max_x
            xa=x*#taille
            ya=y*#taille
            Id = x + (#max_x+1)*y
            If MapTest(x,y)=2
                Box(xa + 1,ya + 1,#taille - 1,#taille - 1,Couleur)
            EndIf
        Next x
    Next y
    StopDrawing()
EndProcedure
Procedure AffOpenClosed()
    CoulOpen=RGB(200,255,200)
    CoulClosed=RGB(255,200,200)
    StartDrawing(ScreenOutput())
    For y=0 To #max_y
        For x=0 To #max_x
            xa=x*#taille
            ya=y*#taille
            Id = x + (#max_x+1)*y
            If Noeud(Id)\Closed
                Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulClosed)
            ElseIf Noeud(Id)\Open
                Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulOpen)
                EndIf
             DrawingMode(#PB_2DDrawing_Transparent)   
            DrawText(xa + 3, ya + 2, Str(Noeud(Id)\f))
            DrawText(xa + 3, ya + 18, Str(Noeud(Id)\h))
            ;DrawText(xa + 3, ya + 4, Str(Noeud(Id)\f))
        Next x
    Next y
    StopDrawing()
EndProcedure
Procedure affPath()
   
    Couleur=RGB(255,0,0)
    tps=ElapsedMilliseconds()
    Destination\x = ciblex
    Destination\y = cibley
    If ChercheChemin()=1
        Chrono=ElapsedMilliseconds()-tps
        If Chrono>ChronoMax
            ChronoMax=Chrono
        EndIf   
        a=-1
        b=-1
       
        cx=Destination\x
        cy=Destination\y
       
        StartDrawing(ScreenOutput())
        While a <> departx Or b <> departy
            a = parent(cx,cy)\x
            b = parent(cx,cy)\y
           
            xa=(cx*#taille)+#taille/2
            ya=(cy*#taille)+#taille/2
            xb=(a*#taille)+#taille/2
            yb=(b*#taille)+#taille/2
            LineXY(xa,ya,xb,yb,Couleur)
            cx = a
            cy = b
        Wend
        ;Circle(Destination\x*#taille+#taille/2,Destination\y*#taille+#taille/2,#taille/2,Couleur)
        StopDrawing()
    ElseIf Proche
 
         
       BestF = #max_y * #max_x * 2
       BestG = BestF
       For y=0 To #max_y
         For x=0 To #max_x
            Id = x + (#max_x+1)*y
            If Noeud(Id)\Open
               If Noeud(Id)\f > 0 And (Noeud(Id)\f < BestF Or((Noeud(Id)\f = BestF) And Noeud(Id)\h < BestH))
                  BestF = Noeud(Id)\f
                  BestH = Noeud(Id)\h
                  cx=x
                  cy=y
               EndIf
               
            EndIf
         Next x
      Next y
      StartDrawing(ScreenOutput())
        While a <> departx Or b <> departy
            a = parent(cx,cy)\x
            b = parent(cx,cy)\y
           
            xa=(cx*#taille)+#taille/2
            ya=(cy*#taille)+#taille/2
            xb=(a*#taille)+#taille/2
            yb=(b*#taille)+#taille/2
            LineXY(xa,ya,xb,yb,Couleur)
            cx = a
            cy = b
        Wend
        ;Circle(Destination\x*#taille+#taille/2,Destination\y*#taille+#taille/2,#taille/2,Couleur)
        StopDrawing()
      
 
    EndIf 
          
  
EndProcedure
Procedure AffCadre()
    Couleur=RGB(255,255,255)
    StartDrawing(ScreenOutput())
    DrawingMode(4)
    Box(0,0,#taille*(#max_x+1),#taille*(#max_y+1),Couleur)
    StopDrawing()
EndProcedure
; ************************************************************************************
; *** BOUCLE PRINCIPALE ***
; ************************************************************************************
Repeat
    ClearScreen(0)
    ;/ état du clavier
    If ExamineKeyboard()
        If KeyboardReleased(#PB_Key_F1)
            AffOpenClosed=1-AffOpenClosed
        ElseIf KeyboardReleased(#PB_Key_F2)
            affPath=1-affPath
        ElseIf KeyboardReleased(#PB_Key_F3)
            SauveMap()
        ElseIf KeyboardReleased(#PB_Key_F4)
            ChargeMap()
        ElseIf KeyboardReleased(#PB_Key_F5)
            AffGrille=1-AffGrille
        ElseIf KeyboardReleased(#PB_Key_F6)
            EffaceMur()
        ElseIf KeyboardReleased(#PB_Key_F7)
            diagonale=1-diagonale
        ElseIf KeyboardReleased(#PB_Key_F8)
            Proche=1-Proche
           EndIf
        ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
    EndIf
    ;/ Gestion de la souris
    souris(ToucheShift)
   

   
    mur()
    If AffGrille
        AffGrille()
    EndIf
    AffCadre()
    If AffOpenClosed
        AffOpenClosed()
    EndIf
   
    ;/Lance la recherche
    If affPath
        affPath()
    Else
        ChronoMax=0
    EndIf
   
    ;/Affiche les sprites
    DisplayTransparentSprite(#Souris,MouseX() - #taille / 2,MouseY() - #taille / 2)
    DisplayTransparentSprite(#cible,ciblex * #taille,cibley * #taille)
    DisplayTransparentSprite(#depart,departx * #taille,departy * #taille)
   
    FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

End 
Dernière modification par comtois le ven. 19/mai/2006 22:32, modifié 1 fois.
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

Bon ba j'ai plus besoin de chercher alors..En tout cas un grand merci tu m'as fait comprendre beaucoup de chose :D
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

tu peux encore réfléchir, en changeant 3 ou 4 lignes il devrait être possible d'améliorer la recherche du point le plus proche.
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

J'utilise le pathfinding de comtois dans mon jeu, que j'ai transformé en une procedure qui ecrit en mémoire le chemin. il est tres simple alors de faire suivre un chemin a un personnage.
Mon problème c'est que j'ai des cases dans ma map qui permettent de se téléphorté en gros Map(x,y)\TeleporteX et Map(x,y)\TeleporteY j'aurais voucu que le pathinding prennent en compte cette possibilité pour aller d'un point A a un point B. Est ce que tu aurais une idée de comment je pourrais modifier ton code pour prendre cela en compte ? voici mon code actuel

Code : Tout sélectionner

Structure Noeud
  Id.l
  x.l
  y.l
  f.l
  G.l
  H.l
  Open.l
  Closed.l
EndStructure
#max_x=50
#max_Y=50

;fonction qui indique si on peut passer ou pas ... :o)
;test la map et retourne 0 si on peut passé et 1 si on ne peut pas passer.
Procedure.b MapTestPath(x,y)
  
  If MapType(x,y)=#ELEMENT_TYPE_FLOOR Or MapType(x,y)=#ELEMENT_TYPE_DOOR
    result=0
  Else 
    result=1
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.w ChercheChemin(chara.w,departx,departy,ciblex,cibley,diagonale,proche)
    LePlusProche.point
    Destination.point
    Dim parent.Point(#max_x,#max_y)
    Dim Noeud.Noeud((#max_x+1)*(#max_y+1))
    Dim Tas((#max_x+1)*(#max_y+1))
    Debug "Dx:"+Str(departx)+" Dy:"+Str(departy)+" Cx:"+Str(ciblex)+" CY:"+Str(cibley)
    ;Initialise le tableau Noeud
    Dim Noeud.Noeud((#max_x+1)*(#max_y+1))
   Destination\x=ciblex
   Destination\y=cibley
    ;Si on est déjà arrivé pas la peine d'aller plus loin
    If departx=Destination\x And departy=Destination\y
        ProcedureReturn 0
    EndIf
   
    ;Calcul Un ID unique pour le Noeud en cours
    NoeudID = departx
    NoeudID + (#max_x+1) * departy
   
    ; --- on met le point de départ dans le tas ---
    ;Un tas c'est un arbre , habituellement binaire.
    ;Il permet de retrouver rapidement le f le plus petit ,sans avoir à trier l'ensemble des Noeuds.
   
    Taille_Tas = 1
    Tas(Taille_Tas)=NoeudID
    Noeud(NoeudID)\x=departx
    Noeud(NoeudID)\y=departy
    Noeud(NoeudID)\Open=1
   
    ; --- tant que la liste open n'est pas vide et tant qu'on a pas trouvé la cible
    While fin = 0
        ; --- il n'y a pas de chemin ---
        If Taille_Tas = 0
            fin = 2
            Debug "il n'y a pas de chemin"
            Break
        Else
           
            ; --- on récupère la Case la plus avantageuse ( avec F le plus bas) ===
           
            NoeudID=Tas(1)
            x=Noeud(NoeudID)\x
            y=Noeud(NoeudID)\y
            Noeud(NoeudID)\Closed=1
           
           
            ;Supprime un noeud du tas
            Tas(1) = Tas(Taille_Tas)
            Taille_Tas - 1
           
            ;Retasse le tas après une suppression
            v = 1
           
            Repeat
                u = v
                If 2*u+1 <= Taille_Tas
                    If Noeud(Tas(u))\f >= Noeud(Tas(2*u))\f : v = 2*u   : EndIf
                    If Noeud(Tas(v))\f >= Noeud(Tas(2*u+1))\f : v = 2*u+1 : EndIf
                ElseIf 2*u <= Taille_Tas
                    If Noeud(Tas(u))\f >= Noeud(Tas(2*u))\f : v = 2*u : EndIf
                EndIf
               
                If u <> v
                    temp = Tas(u)
                    Tas(u) = Tas(v)
                    Tas(v) = temp
                Else
                    Break ; la propriété du tas est rétablie , on peut quitter
                EndIf
            ForEver
           
        EndIf
       
       
        ; --- on teste les cases autour de la case sélectionnée ===
       
        For a = x - 1 To x + 1
            For b = y - 1 To y + 1
                ;Conditions de validité d'une case
                If a >= 0 And a <= #max_x And b >= 0 And b <= #max_y And (diagonale=1 Or a = x Or b = y) And (a = x Or b = y Or MapTestPath(a,y)=0 Or MapTestPath(x,b)=0)
                   
                    ;Calcul un ID unique
                    TempID = a
                    TempID + (#max_x+1) * b
                   
                    ; ---- si la Case est libre et n'a pas encore été traitée
                    If MapTestPath(a,b) = 0 And Noeud(TempID)\Closed = 0
                       
                        ; calcule G pour la Case en cours de test ( à adapter selon le jeu)
                        ; si la distance n'a pas d'importance , on peut se contenter de calculer
                        ; le nombre de cases , donc de faire G = G(x,y) + 1
                       
                        If a <> x And b <> y
                            G = 14 + Noeud(NoeudID)\G ;
                        Else
                            G = 10 + Noeud(NoeudID)\G ;
                        EndIf
                       
                       
                        ; si la Case n'est pas dans la liste open ou si est meilleur en passant par cette case
                        If Noeud(TempID)\Open = 0 Or G < Noeud(TempID)\G
                           
                            parent(a,b)\x = x
                            parent(a,b)\y = y
                            Noeud(TempID)\G = G
                            Noeud(TempID)\H = (Abs(ciblex-a) + Abs(cibley-b))*10
                            Noeud(TempID)\f = Noeud(TempID)\G + Noeud(TempID)\H
                                                       
                            If Noeud(TempID)\Open = 0
                               
                                ;Ajoute le Noeud dans le tas
                                Taille_Tas + 1
                                Tas(Taille_Tas) = TempID
                                Noeud(TempID)\x = a
                                Noeud(TempID)\y = b
                                Noeud(TempID)\Open = 1
                                Position = Taille_Tas
                               
                            Else
                               
                                ;Cherche la position du Noeud dans le tas
                                For i = 1 To Taille_Tas
                                    If Tas(i)=TempID
                                        Position = i
                                        Break
                                    EndIf
                                Next i
                               
                            EndIf
                           
                            ;Retasse le tas à partir du Noeud en cours
                            While Position <> 1
                                If Noeud(Tas(Position))\f <= Noeud(Tas(Position/2))\f
                                    temp = Tas(Position/2)
                                    Tas(Position/2) = Tas(Position)
                                    Tas(Position) = temp
                                    Position = Position/2
                                Else
                                    Break
                                EndIf
                            Wend
                           
                            ; --- la cible est trouvée ---
                            If a = Destination\x And b = Destination\y
                                fin = 1
                                Break 2
                            EndIf
                        EndIf
                    EndIf
                EndIf
            Next b
        Next a
    Wend
    
    Destination\x = ciblex
    Destination\y = cibley 
    a=-1
    b=-1
    cx=Destination\x
    cy=Destination\y
    
    ;Si on a pas le chemin on trouve le point le plus proche.
    If fin=2
     BestF = #max_y * #max_x * 2
       BestG = BestF
       For y=0 To #max_y
         For x=0 To #max_x
            Id = x + (#max_x+1)*y
            If Noeud(Id)\Open
               If Noeud(Id)\f > 0 And (Noeud(Id)\f < BestF Or((Noeud(Id)\f = BestF) And Noeud(Id)\h < BestH))
                  BestF = Noeud(Id)\f
                  BestH = Noeud(Id)\h
                  cx=x
                  cy=y
               EndIf
               
            EndIf
         Next x
      Next y 
    EndIf
    
    ;Si on a un chemin alors on l'initialise
    If fin=1 Or fin=2
      Dim chem.Point(#PathMaxTile)
      TilePointer=0;
      While (a <> departx Or b <> departy) And TilePointer<#PathMaxTile
            a = parent(cx,cy)\x
            b = parent(cx,cy)\y
            ;Debug Str(a)+","+Str(b)
            ;Map(a,b)\TileType=2
           chem(TilePointer)\x=a
           chem(TilePointer)\y=b
           TilePointer=TilePointer+1
            cx = a
            cy = b
        Wend
        ;On passe tout en mémoire
        MemPointer=0;Adresse mémoire
        PokeB(Character(chara)\Path+MemPointer,fin)
        MemPointer=MemPointer+1
        For z=TilePointer-1 To 0 Step -1
          PokeW(Character(chara)\Path+MemPointer,chem(z)\x)
          MemPointer=MemPointer+2
          PokeW(Character(chara)\Path+MemPointer,chem(z)\y)
          MemPointer=MemPointer+2
        Next
        PokeW(Character(chara)\Path+MemPointer,0)
        PokeW(Character(chara)\Path+MemPointer+1,0)
        Character(chara)\PathPointer=1 ; Je met le pointer au debut du parcour
        
      EndIf  
    ProcedureReturn fin
EndProcedure
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Thyphoon a écrit :Mon problème c'est que j'ai des cases dans ma map qui permettent de se téléphorté en gros Map(x,y)\TeleporteX et Map(x,y)\TeleporteY j'aurais voucu que le pathinding prennent en compte cette possibilité pour aller d'un point A a un point B. Est ce que tu aurais une idée de comment je pourrais modifier ton code pour prendre cela en compte ?
Faudrait préciser un peu plus. Il parait que quand on a énoncé clairement un problème, il est à moitié résolu :)

tes cases de téléportation servent à quoi ? changer de map ou à te déplacer dans la même map ? tu peux en avoir plusieurs par map ? ou seulement pour passer d'une map à l'autre ?
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

comtois a écrit : Faudrait préciser un peu plus. Il parait que quand on a énoncé clairement un problème, il est à moitié résolu :)

tes cases de téléportation servent à quoi ? changer de map ou à te déplacer dans la même map ? tu peux en avoir plusieurs par map ? ou seulement pour passer d'une map à l'autre ?
ça sert a se déplacer dans la même map. Tu peux en avoir plusieurs sur la même map. Et chaque téléportation envoie toujours au même endroit.
Je m'en sert entre autre pour gérer des étages. Genre tu monte des escaliers et tu arrives a l"étage suivant. L'effet est très sympa Une zolie image valant mieux qu'un long discourt, voilà
Image
Pour cela dans la structure de ma map j'ai une information de téléportation si elle est a 0 c'est une case normal si elle a des coordonnées alors c'est qu'il faut que des qu'un personnages passe dessus on le téléporte aux coordonées indiquées.

J'éspère que j'ai été plus claire...

:P
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Comment je ferais ?

Déjà je ne mettrais pas tout sur une seule map, je décomposerais un maximum ma map en petites maps. Par exemple une map par étage.
Et si un étage est vaste, décomposer encore en secteur, nord sud est ouest par exemple. la recherche d'un chemin sera d'autant plus rapide.

Sur ton image, ça me parait curieux de voir 2 étages en même temps , c'est un effet voulu ?

Ensuite je gèrerais la téléportation comme dans le tuto RPG2D dans ma signature, c'est à dire avec une liste d'évènements par map.
si dans ta map tu as 3 escaliers, ça fera 3 évènements, sinon tu seras obligé de réserver de la mémoire pour chaque case pour indiquer les coordonnées de la téléportation alors que c'est inutile.

De plus en mettant en place un système de gestion d'évènements, tu pourras en ajouter d'autres, je crois que tu voulais mettre des interrupteurs , des portes etc ?

Maintenant si tu tiens absolument à gérer un pathfinding entre plusieurs cartes, tu devras passer par des étapes intermédiaires, stocker les points de passage d'une map à l'autre. En clair gérer un autre pathfinding mais cette fois ci pour déterminer par quelles map tu devras passer.

par exemple ton point A se trouve que la carte 'Map01' et ton point B sur la carte 'Map05',
de la map01 tu ne peux aller qu'à la map03
de la map03 tu peux aller à la map01 ou à la map04
de la map04 tu peux aller à la map03 ou à la map05

Autrement dit dans une première recherche tu établis que tu devras aller en :
Map01, puis atteindre la case d'accès à la map03
puis atteindre la case d'accès à la map 04
Puis atteindre la case d'accès à la map 05
et enfin dans la map05 tu calcules ton chemin pour atteindre le point B

Bref c'est bien compliqué. Je ne suis pas sûr que ce soit ce que tu cherches à faire ?

C'est plus simple si tu te fixes un déplacement possible d'une map à l'autre, sans passer par des maps intermédiaires.
Et c'est encore plus simple si tu te contentes de gérer ton pathfinding sur une seule carte. Je n'afficherais qu'une carte à la fois, donc inutile de gérer des passages d'une carte à l'autre par pathfinding, c'est à prévoir seulement par téléportation.
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

Merci pour ta reponse !
Si je ne gère qu'une seule carte, c'est tout simplement que je dois gérer aussi l'AI d' être autonome mais qui depend du décore. C'est plus facile de gérer ça sur une seul map.

Voici ma structure actuel pour ma carte

Code : Tout sélectionner

Structure MapStructure
  Element.w ; N° de l'element (Porte/sol/objet)
  Light.w   ;
  
  Single.b ; 1 si l'element est gérer comme element unique(ex:porte) , 0 comme element global (ex:l'eau qui coule)
  State.b  ; Etat de l'element (ex porte ouverte;sol abimé;)
  Image.w;n° de l'image de l'animation en court
  Delay.l; temps du prochaine changement d'image
  
  Variable.w; variable qui contient en fonction de l'element, certaine information (ex:le N° du bloc ou on est téléporté)

EndStructure
les maps font 512x512 ce qui fait en mémoire en gros 4mo juste pour la carte. je trouve ça tout a fait correcte. Non ?

Et avoir plusieur étage sur une même carte ,n'est pas génant, surtout que ça ne se voit pas pour lejoueur.
Tout cela fonctionne pour l 'instant parfaitement. sauf le pathfing quine trouve pas de chemin lorsque je veux aller d'un point a un autre via une téléportation ...

si tu veux voir ce que ça donne
File:1->Aliens.zip
Image

dans le première pièce il y a un escalier tu peux tricher en appuyant sur F2 pour tout éclairer. sinon tu peux demander a quelqu'un de te suivre en appuyant un clic droit sur lui. idem pour ouvrir une porte clic droit sur la porte. Voilà en gros...
:P

et voilà ce que j'ait tésté comme odification de code mais sans trop de sucès

Code : Tout sélectionner

       ;si on x et y = téléportation alors
       If Map(x,y)\Variable>0 ; On est alors téléporté
        tmpy=Int(Map(x,y)\Variable/#MapWidthMax) ;calcul des coordoné y
        tmpx=Map(x,y)\Variable-tmpy*#MapWidthMax;calcul des coordonée x
        x=tmpx
        y=tmpy
       EndIf
       
       
        ; --- on teste les cases autour de la case sélectionnée ===
le code est mis juste avant le test des case au tour ...
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

tu ne peux pas utiliser le pathfinding pour ça.

Puisque tu n'as qu'une map, découpe la en région, et gère le passage d'une région à une autre comme décrit précédemment.
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

comtois a écrit :tu ne peux pas utiliser le pathfinding pour ça.

Puisque tu n'as qu'une map, découpe la en région, et gère le passage d'une région à une autre comme décrit précédemment.
Merci beaucoup ça marche parfaitement ... :D
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

Crois tu qu'il y a moyen de mêtre des limits dans ton pathfinding ? Genre on cherche mais on s'arrête a tant de "case" au tour du point de depart ?
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

tu as juste une condition à ajouter, tu remplaces Noeud(NoeudID)\G < 60 par ce que tu veux, soit une distance à vol d'oiseau , ou G qui est la distance réelle pour atteindre la cible.

Code : Tout sélectionner

;Conditions de validité d'une case
If Noeud(NoeudID)\G < 60 And a >= 0 And a <= #max_x And b >= 0 And b <= #max_y And (diagonale=1 Or a = x Or b = y) And (a = x Or b = y Or map(a,y)=0 Or map(x,b)=0)
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

comtois a écrit :tu as juste une condition à ajouter, tu remplaces Noeud(NoeudID)\G < 60 par ce que tu veux, soit une distance à vol d'oiseau , ou G qui est la distance réelle pour atteindre la cible.

Code : Tout sélectionner

;Conditions de validité d'une case
If Noeud(NoeudID)\G < 60 And a >= 0 And a <= #max_x And b >= 0 And b <= #max_y And (diagonale=1 Or a = x Or b = y) And (a = x Or b = y Or map(a,y)=0 Or map(x,b)=0)
Merci c'est genial !!! :) j'avais bidouiller un truc mais là c'est quand même plus propre..Un grand merci
Répondre