Je vais essayercomtois 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

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
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
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
Faudrait préciser un peu plus. Il parait que quand on a énoncé clairement un problème, il est à moitié résoluThyphoon 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 ?
ç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.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 ?
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
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 ===
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 !!!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)