Pathfinding , nouvelle version

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

J'ai remplacé

Code : Tout sélectionner

interdit = 0
                        
If a=x-1 And b=y-1 And map(x,y-1)=1 And map(x-1,y)=1 : interdit=1 : EndIf
If a=x-1 And b=y+1 And map(x,y+1)=1 And map(x-1,y)=1 : interdit=1 : EndIf
If a=x+1 And b=y-1 And map(x,y-1)=1 And map(x+1,y)=1 : interdit=1 : EndIf
If a=x+1 And b=y+1 And map(x,y+1)=1 And map(x+1,y)=1 : interdit=1 : EndIf
If interdit = 0
par

Code : Tout sélectionner

If a = x Or b =y Or map(a,y)=0 Or map(x,b)=0
Et j'ai ajouté l'option Sans/Avec diagonale.
Haut
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

Ca me donne envie de refaire un chtit truc 2D en pure :'(
Enfin entre les routines de Son à programmer et le temps qui me manque ^^

Dri
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

J'ai ajouté la recherche du point le plus proche dans le cas ou la cible ne peut pas être atteinte.
C'est peut-être pas la meilleure méthode mais ça me permet de recycler l a procédure Remplissage() déjà présentée dans un autre post :)

Pour tester il faut enfermer la cible ou le départ, et valider par la touche F8.

Code : Tout sélectionner

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


; **********************************************************************
; ************************** 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=58
#max_y=58
#max_x1=#max_x+1
#taille=10


; --- 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 ---
Dim map(#max_x,#max_y)
Dim MapTest(#max_x,#max_y)
Dim parent.point(#max_x,#max_y)
Dim Tas((#max_x+1)*(#max_y+1))
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(ciblex)
        WriteLong(cibley)
        WriteLong(departx)
        WriteLong(departy)
        
        For y=0 To #max_y
            For x=0 To #max_x
                WriteLong(map(x,y))
            Next x
        Next y
        CloseFile(0)
    EndIf    
EndProcedure
Procedure ChargeMap()
    If OpenFile(0,"PathFindingMap.map")
        ciblex=ReadLong()
        cibley=ReadLong()
        departx=ReadLong()
        departy=ReadLong()
        For y=0 To #max_y
            For x=0 To #max_x
                map(x,y) = ReadLong()
            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(255,255,255)
    Col=0
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F1] Sans/Avec open et closed")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F2] Sans/Avec Recherche")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F3] Sauve la Map")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F4] Charge la Map")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F5] Sans/Avec Grille")
    
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F6] Efface la Map")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F7] Sans/Avec Diagonale")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F8] Sans/Avec proche")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[F9] Sans/Avec Zone proche")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[Bouton Gauche] Ajoute un mur")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[Bouton Droit] Efface un mur")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[Bouton Gauche] + [Shift] Cible")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("[Bouton Droit] + [Shift] Départ")
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("Position : " + Str(MouseX()/#taille) + " / " + Str(MouseY()/#taille))    
    
    Locate(#taille*(#max_x+1),lig) : lig + 20
    DrawText("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 remplissage(*P.point)
    Psp = 1
    Dim Px(1000)
    Dim Py(1000)
    Px(0) = departx
    Py(0) = departy
    lim = 1
    c = 2
    
    CopyMemory(map(),MapTest(),(#max_x+1)*(#max_y+1)*4)
    distanceMini=-1
    While Psp <> 0
        xi = Px(Psp - 1)
        xf = Px(Psp - 1)
        x  = Px(Psp - 1)
        y  = Py(Psp - 1)
        x + 1
        cp = MapTest(x, y)
        
        While cp <> lim And x <= #max_x
            xf = x
            x + 1
            cp = MapTest(x, y)
        Wend
        x = Px(Psp - 1) - 1
        cp = MapTest(x, y)
        While cp <> lim And x >= 0
            xi = x
            x - 1
            cp = MapTest(x, y) 
        Wend
        
        ;Rechercher le point le plus proche ici !!
        
        If xi<xf
            a=xi
            b=xf
        Else
            a=xf
            b=xi
        EndIf    
        
        For i=a To b 
            MapTest(i,y)=c
            distance=(Abs(ciblex-i) + Abs(cibley-y))*10
            If distance < distanceMini Or distanceMini = -1
                distanceMini = distance
                *P\x = i
                *P\y = y
            EndIf    
        Next i
        
        ;Si la cible est trouvée , on ne va pas plus loin 
        If *P\x = ciblex And *P\y=cibley
            Break
        EndIf
        
        Psp - 1
        ;Y+1
        x = xf
        While x >= xi And y < #max_y  
            cp = MapTest(x, y + 1)
            While (((cp = lim) Or (cp = c)) And (x >= xi))
                x - 1
                cp = MapTest(x, y + 1) 
            Wend
            If ((x >= xi) And (cp <> lim) And (cp <> c))
                Px(Psp) = x
                Py(Psp) = y + 1
                Psp + 1
            EndIf
            cp = MapTest(x, y + 1)
            While (( cp <> lim ) And ( x >= xi ))
                x - 1
                cp = MapTest(x,y+1)
            Wend
        Wend 
        
        ;Y-1
        x = xf
        While x >= xi And y > 0
            cp = MapTest(x, y - 1)
            While (((cp = lim) Or (cp = c)) And (x >= xi))
                x - 1
                cp = MapTest(x, y - 1) 
            Wend
            If ((x >= xi) And (cp <> lim) And (cp <> c))
                Px(Psp) = x
                Py(Psp) = y - 1
                Psp + 1 
            EndIf
            cp = MapTest(x, y - 1)
            While (( cp <> lim ) And ( x >= xi ))
                x - 1
                cp = MapTest(x,y-1)
            Wend
        Wend
    Wend
EndProcedure 
    
Procedure.w ChercheChemin()
    
    ;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)\f = Noeud(TempID)\G 
                            Noeud(TempID)\f + (Abs(ciblex-a) + Abs(cibley-b))*10
                            
                            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)
                    ciblex = SX : cibley = SY ; place la cible
                ElseIf MouseButton(2)
                    departx = SX : departy = SY ; place le départ
                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
        Next x
    Next y
    StopDrawing()
EndProcedure
Procedure affPath()
    Couleur=RGB(55,255,150)
    tps=ElapsedMilliseconds()
    
    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()
    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,0,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
        ElseIf KeyboardReleased(#PB_Key_F9)
            Remplissage=1-Remplissage            
        EndIf
        ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
    EndIf
    ;/ Gestion de la souris
    souris(ToucheShift)
    
    ;/affiche le fond
    If Proche Or Remplissage
        remplissage(@LePlusProche)
        If Remplissage 
            AffRemplissage()
        EndIf
    EndIf    
    If Proche
        Destination\x=LePlusProche\x
        Destination\y=LePlusProche\y
    Else
        Destination\x=ciblex
        Destination\y=cibley 
    EndIf    
    
    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 dim. 17/juil./2005 6:18, modifié 1 fois.
Haut
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

Fonctionne nickel ^^

Dri :10:
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Voici une version qui marche avec la V4.
Mais j'ai pas réussi a faire fonctionné le système de remplissage ni le point le plus proche. D'ailleur si une solution plus simple existe pour le point le plus proche je suis interessé :P
En tout cas merci contois pour le code d'origine j'ai enfin compris comment fonctionnait un Pathfinder :D

Code : Tout sélectionner

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


; ********************************************************************** 
; ************************** 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") 
    
     lig + 20 
    DrawText(#taille*(#max_x+1),lig,"[F8] Sans/Avec proche") 
    
    lig + 20 
    DrawText(#taille*(#max_x+1),lig,"[F9] Sans/Avec Zone 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 remplissage(*P.point) 
    Psp = 1 
    Dim Px(1000) 
    Dim Py(1000) 
    Px(0) = departx 
    Py(0) = departy 
    lim = 1 
    c = 2 
    
    CopyMemory(map(),MapTest(),(#max_x+1)*(#max_y+1)*4) 
    distanceMini=-1 
    While Psp <> 0 
        xi = Px(Psp - 1) 
        xf = Px(Psp - 1) 
        x  = Px(Psp - 1) 
        y  = Py(Psp - 1) 
        x + 1 
        cp = MapTest(x, y) 
        
        While cp <> lim And x <= #max_x 
            xf = x 
            x + 1 
            cp = MapTest(x, y) 
        Wend 
        x = Px(Psp - 1) - 1 
        cp = MapTest(x, y) 
        While cp <> lim And x >= 0 
            xi = x 
            x - 1 
            cp = MapTest(x, y) 
        Wend 
        
        ;Rechercher le point le plus proche ici !! 
        
        If xi<xf 
            a=xi 
            b=xf 
        Else 
            a=xf 
            b=xi 
        EndIf    
        
        For i=a To b 
            MapTest(i,y)=c 
            distance=(Abs(ciblex-i) + Abs(cibley-y))*10 
            If distance < distanceMini Or distanceMini = -1 
                distanceMini = distance 
                *P\x = i 
                *P\y = y 
            EndIf    
        Next i 
        
        ;Si la cible est trouvée , on ne va pas plus loin 
        If *P\x = ciblex And *P\y=cibley 
            Break 
        EndIf 
        
        Psp - 1 
        ;Y+1 
        x = xf 
        While x >= xi And y < #max_y  
            cp = MapTest(x, y + 1) 
            While (((cp = lim) Or (cp = c)) And (x >= xi)) 
                x - 1 
                cp = MapTest(x, y + 1) 
            Wend 
            If ((x >= xi) And (cp <> lim) And (cp <> c)) 
                Px(Psp) = x 
                Py(Psp) = y + 1 
                Psp + 1 
            EndIf 
            cp = MapTest(x, y + 1) 
            While (( cp <> lim ) And ( x >= xi )) 
                x - 1 
                cp = MapTest(x,y+1) 
            Wend 
        Wend 
        
        ;Y-1 
        x = xf 
        While x >= xi And y > 0 
            cp = MapTest(x, y - 1) 
            While (((cp = lim) Or (cp = c)) And (x >= xi)) 
                x - 1 
                cp = MapTest(x, y - 1) 
            Wend 
            If ((x >= xi) And (cp <> lim) And (cp <> c)) 
                Px(Psp) = x 
                Py(Psp) = y - 1 
                Psp + 1 
            EndIf 
            cp = MapTest(x, y - 1) 
            While (( cp <> lim ) And ( x >= xi )) 
                x - 1 
                cp = MapTest(x,y-1) 
            Wend 
        Wend 
    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)\f = Noeud(TempID)\G 
                            Noeud(TempID)\f + (Abs(ciblex-a) + Abs(cibley-b))*10 
                            
                            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) 
                    ciblex = SX : cibley = SY ; place la cible 
                ElseIf MouseButton(2) 
                    departx = SX : departy = SY ; place le départ 
                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 
        Next x 
    Next y 
    StopDrawing() 
EndProcedure 
Procedure affPath()
   
    Couleur=RGB(255,0,0) 
    tps=ElapsedMilliseconds() 
    
    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() 
    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 
        ElseIf KeyboardReleased(#PB_Key_F9) 
            Remplissage=1-Remplissage            
        EndIf 
        ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift) 
    EndIf 
    ;/ Gestion de la souris 
    souris(ToucheShift) 
    
    ;/affiche le fond 
    If Proche Or Remplissage 
        remplissage(@LePlusProche) 
        If Remplissage 
            AffRemplissage() 
        EndIf 
    EndIf    
    If Proche 
        Destination\x=LePlusProche\x 
        Destination\y=LePlusProche\y 
    Else 
        Destination\x=ciblex 
        Destination\y=cibley 
    EndIf    
    
    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
Haut
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

Magique comme truc 8)

Celà trouve-t-il le "plus court" chemin ou seulement un chemin "possible" ?
Dernière modification par Frenchy Pilou le mer. 17/mai/2006 11:37, modifié 1 fois.
Est beau ce qui plaît sans concept :)
Speedy Galerie
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Frenchy Pilou a écrit :Magique comme truc 8)

Celà trouve-t-il le "plus court" chemin ou seulement un "chemin possible" ?
Le chemin le plus court :P
Haut
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

Le nombre de "points" étant 2 fois plus grand, le temps de calcul augmenterait-il de façon exponentielle ?

C'est un Algo "maison" ou une reprise d'un "classique" ?
Est beau ce qui plaît sans concept :)
Speedy Galerie
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Frenchy Pilou a écrit :Le nombre de "points" étant 2 fois plus grand, le temps de calcul augmenterait-il de façon exponentielle ?

C'est un Algo "maison" ou une reprise d'un "classique" ?
Il faut demander a contois mais a mon avis c'est un algo qui existe déjà type A-Star ou djikstra.
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

Oui c'est un classique , le célèbre A*. Enfin j'espère que c'est bien le A* que j'ai codé :)

Pour le point le plus proche , je voulais comparer la vitesse de la recherche entre l'algo de remplissage ( c'est le même que pour un FillArea) et l'algo du A*, mais je n'ai jamais pris le temps d'approfondir.

Je pense que tu peux supprimer la procédure Remplissage et faire la recherche directement avec A*.

Dans le code actuel pour voir le point le plus proche, il faut enfermer complètement la cible , et tu devrais voir le tracé s'arrêter au 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.
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

comtois a écrit : Dans le code actuel pour voir le point le plus proche, il faut enfermer complètement la cible , et tu devrais voir le tracé s'arrêter au point le plus proche.
chez moi le point le plus proche ça plante .... :P Apparement tu te servait de la fonction remplissage pour trouver le point le plus proche...
J'ai un Array index out of bounds dans la fonction remplissage(*P.point)
dans la boucle While cp <> lim And x <= #max_x a la ligne cp = MapTest(x, y)
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

oui je suis tombé aussi sur ce bug mais j'ai eu la flemme de le corriger :P
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.
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

J'ai supprimé le remplissage qui ne servait à rien , et je l'ai remplacé par une recherche du point le plus proche avec la fonction ChercheChemin.

J'ai pas vraiment testé, il y a peut-être des bugs ?
Disons que j'ai juste fait un test rapide, le point le plus proche s'affiche.

Le principe est simple il suffit de rechercher parmi les Noeuds Open celui qui a le F le plus petit. Dans cette démo j'appelle une première fois ChercheChemin() pour déterminer le point le plus proche.
Je n'ai pas pris le temps d'étudier le code, mais je pense que c'est parfaitement inutile.
Il suffit d'appeler une seule fois la fonction et de tester le résultat.
Si le résultat est 1 alors la cible peut être atteinte,sinon il faut chercher le point le plus proche dans les noeuds open.

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")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F8] Sans/Avec 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)\f = Noeud(TempID)\G
                            Noeud(TempID)\f + (Abs(ciblex-a) + Abs(cibley-b))*10
                           
                            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)
                    ciblex = SX : cibley = SY ; place la cible
                ElseIf MouseButton(2)
                    departx = SX : departy = SY ; place le départ
                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
        Next x
    Next y
    StopDrawing()
EndProcedure
Procedure affPath()
   
    Couleur=RGB(255,0,0)
    tps=ElapsedMilliseconds()
   
    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()
    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)
   
    ;/affiche le fond
 
    If Proche
         Destination\x=ciblex
         Destination\y=cibley    
         If ChercheChemin()<>1
         
            TestF = #max_y * #max_x * 2
             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 < TestF
                        testF = Noeud(Id)\f 
                        Destination\x=x
                        Destination\y=y
                     EndIf
                     
                  EndIf
               Next x
         Next y
 EndIf
    EndIf   
   
    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
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.
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Il y a un bug car ton dernier code si il n'y a pas d'obstacle le chemin n'atteind pas la cible et vas toujours en dans le coin en haut a gauche
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

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 :)
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.
Haut
Répondre

Revenir à « Trucs et astuces »