Publié : lun. 19/mars/2007 21:03
donc Noeud(NoeudID)\G pour la distance a vol d'oiseau et Noeud(NoeudID)\H pour la distance réeel c'est bien ça ?
Forums PureBasic - Français
http://forums.purebasic.com/french/
Code : Tout sélectionner
; ************************************************************
; ** Comtois le 17/07/05 - Pathfinding pour Purebasic V0.5 **
; ** Tentative de rajout de Danger Part Thyphoon le 25/03/07**
; ************************************************************
; 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 **
; ** Bouton Gauche de la souris + la Touche [Crtl] Rajoute un Danger **
; ** Bouton Droit de la souris + la touche [Ctrl] Supprimer un Danger **
; **********************************************************************
; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
End
EndIf
LoadFont (1, "Arial", 7)
; --- 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
#NbZoneDangerMax=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 ---
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))
Global Dim ZoneDanger.Point(#NbZoneDangerMax)
Global NbZoneDanger=0
; ************************************************************************************
; *** LES SPRITES ***
; ************************************************************************************
Enumeration
#depart
#cible
#Souris
#Danger
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()
;/Danger
CreateSprite(#Danger, #taille, #taille)
StartDrawing(SpriteOutput(#cible))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,0,0))
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 danger()
Couleur=RGB(0,255,0)
StartDrawing(ScreenOutput())
For z=1 To NbZoneDanger
Circle(ZoneDanger(z)\x*#taille + #taille/2,ZoneDanger(z)\y*#taille + #taille/2,#taille/2,Couleur)
Next
StopDrawing()
EndProcedure
Procedure.l CalculDanger(x.l,y.l)
Danger=-1
For z=1 To NbZoneDanger
Vx=Abs(ZoneDanger(z)\x-x)
Vy=Abs(ZoneDanger(z)\y-y)
Tmp_Danger=Vx+Vy
If Tmp_Danger<Danger Or Danger=-1
Danger=Tmp_Danger
EndIf
Next
If Danger>10 ; Nombre de case ou le danger est concidéré comme n'étant pas dangereurx
Danger=0
Else
Danger=10-Danger
EndIf
ProcedureReturn Danger*10
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,"[Bouton Gauche] + [Ctrl] Rajoute un Danger")
lig + 20
DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] + [Ctrl] Supprime un Danger")
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
;-Thyphoon Modif
Noeud(TempID)\f = Noeud(TempID)\G + Noeud(TempID)\H+CalculDanger(x,y)
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,ToucheCtrl)
If ExamineMouse()
SX = MouseX() / #taille
SY = MouseY() / #taille
If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y
If ToucheCtrl=1
If MouseButton(1) And NbZoneDanger<#NbZoneDangerMax
NbZoneDanger=NbZoneDanger+1
ZoneDanger(NbZoneDanger)\x=SX
ZoneDanger(NbZoneDanger)\y=SY
Delay(100)
ElseIf MouseButton(2) And NbZoneDanger>0
NbZoneDanger-1
Delay(100)
EndIf
ElseIf ToucheShift = 1
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
Else
If MouseButton(1)
map(SX,SY)=1 ;place un mur
ElseIf MouseButton(2)
map(SX,SY)=0 ; supprime un Mur
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)
DrawingFont(FontID(1))
DrawText(xa + 3, ya + 1, "f="+Str(Noeud(Id)\f))
DrawText(xa + 3, ya + 10, "h="+Str(Noeud(Id)\h))
DrawText(xa + 3, ya + 19, "D="+Str(CalculDanger(x,y)))
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)
ToucheCtrl = KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
EndIf
;/ Gestion de la souris
souris(ToucheShift,ToucheCtrl)
mur()
If AffGrille
AffGrille()
EndIf
AffCadre()
If AffOpenClosed
AffOpenClosed()
EndIf
;/Lance la recherche
If affPath
affPath()
Else
ChronoMax=0
EndIf
danger()
;/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
; ************************************************************
; ** Comtois le 17/07/05 - Pathfinding pour Purebasic V0.5 **
; ** Tentative de rajout de Danger Part Thyphoon le 25/03/07**
; ************************************************************
; 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 **
; ** Bouton Gauche de la souris + la Touche [Crtl] Rajoute un Danger **
; ** Bouton Droit de la souris + la touche [Ctrl] Supprimer un Danger **
; **********************************************************************
; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
End
EndIf
LoadFont (1, "Arial", 7)
; --- 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=64
#max_y=64
#max_x1=#max_x+1
#taille=8
#NbZoneDangerMax=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 ---
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))
Global Dim ZoneDanger.Point(#NbZoneDangerMax)
Global NbZoneDanger=0
; ************************************************************************************
; *** LES SPRITES ***
; ************************************************************************************
Enumeration
#depart
#cible
#Souris
#Danger
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()
;/Danger
CreateSprite(#Danger, #taille, #taille)
StartDrawing(SpriteOutput(#cible))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,0,0))
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 danger()
Couleur=RGB(0,255,0)
StartDrawing(ScreenOutput())
For z=1 To NbZoneDanger
Circle(ZoneDanger(z)\x*#taille + #taille/2,ZoneDanger(z)\y*#taille + #taille/2,#taille/2,Couleur)
Next
StopDrawing()
EndProcedure
Procedure.l CalculDanger(x.l,y.l)
Danger=-1
For z=1 To NbZoneDanger
Vx=Abs(ZoneDanger(z)\x-x)
Vy=Abs(ZoneDanger(z)\y-y)
Tmp_Danger=Vx+Vy
If Tmp_Danger<Danger Or Danger=-1
Danger=Tmp_Danger
EndIf
Next
If Danger>10 ; Nombre de case ou le danger est concidéré comme n'étant pas dangereurx
Danger=0
Else
Danger=10-Danger
EndIf
ProcedureReturn Danger*10
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,"[Bouton Gauche] + [Ctrl] Rajoute un Danger")
lig + 20
DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] + [Ctrl] Supprime un Danger")
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(u<<1))\f : v = u<<1 : EndIf
If Noeud(Tas(v))\f >= Noeud(Tas(u<<1+1))\f : v = u<<1+1 : EndIf
ElseIf u<<1 <= Taille_Tas
If Noeud(Tas(u))\f >= Noeud(Tas(u<<1))\f : v = u<<1 : 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 = 3 + Noeud(NoeudID)\G ;
Else
G = 1 + 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
;-Thyphoon Modif
Noeud(TempID)\f = Noeud(TempID)\G + Noeud(TempID)\H;+CalculDanger(x,y)
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>>1))\f
temp = Tas(Position>>1)
Tas(Position>>1) = Tas(Position)
Tas(Position) = temp
Position = Position>>1
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,ToucheCtrl)
If ExamineMouse()
SX = MouseX() / #taille
SY = MouseY() / #taille
If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y
If ToucheCtrl=1
If MouseButton(1) And NbZoneDanger<#NbZoneDangerMax
NbZoneDanger=NbZoneDanger+1
ZoneDanger(NbZoneDanger)\x=SX
ZoneDanger(NbZoneDanger)\y=SY
Delay(100)
ElseIf MouseButton(2) And NbZoneDanger>0
NbZoneDanger-1
Delay(100)
EndIf
ElseIf ToucheShift = 1
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
Else
If MouseButton(1)
map(SX,SY)=1 ;place un mur
ElseIf MouseButton(2)
map(SX,SY)=0 ; supprime un Mur
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)
DrawingFont(FontID(1))
DrawText(xa + 3, ya + 1, "f="+Str(Noeud(Id)\f))
DrawText(xa + 3, ya + 10, "h="+Str(Noeud(Id)\h))
DrawText(xa + 3, ya + 19, "D="+Str(CalculDanger(x,y)))
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)
ToucheCtrl = KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
EndIf
;/ Gestion de la souris
souris(ToucheShift,ToucheCtrl)
mur()
If AffGrille
AffGrille()
EndIf
AffCadre()
If AffOpenClosed
AffOpenClosed()
EndIf
;/Lance la recherche
If affPath
affPath()
Else
ChronoMax=0
EndIf
danger()
;/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
t'inquiète j'ai fait l'erreur avant toi , d'autre l'on fait, et encore d'autre le ferontHuitbit a écrit :Désolé pour cette perte de temps!
![]()
Code : Tout sélectionner
; 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