j'ai fait ce code pour 3Arks / Arkeos, c'est basé sur l'algorithme A star, modifié car c'est vraiment pour les jeux vidéo. Ce code permet de calculer un parcours entre 2 coordonnées.
Pour ceux qui ne connaisse pas A* c'est un algorithme de calcul de parcours justement. Pour faire les 'collisions', l'algo ne prend pas en compte les murs parmi les 'voisins'. L'algo s'arrête au bout d'un certains temps et prendra le parcours vers la case la plus proche de l'objectif si il n'a pas réussi à calculer le chemin.
Ici le code source de mon algorithme de chemin (suivis d'un exemple d'utilisation) :
Code : Tout sélectionner
;-*****************************************************************************
;-* Algorithme A* modifié et optimisé pour les jeux vidéo *
;-* *
;-* Auteur : stombretrooper *
;-* Libre de droits. *
;-*****************************************************************************
;- Structures
Structure pos
X.w
Y.w
EndStructure
Structure pos_pond
X.w
Y.w
Poid.l
EndStructure
Structure node
X.w
Y.w
*suivant.node
EndStructure
Structure path
*start.node
*current.node
X.w
Y.w
XFin.w
YFin.w
Fin.a
EndStructure
Structure closed_node
X.w
Y.w
*prec.path
longueur.l
EndStructure
Global Dim col(100,100)
Global mut = CreateMutex()
Global ram = 0
;- Fonction de test si c'est un mur ou non, à modifié selon votre système de collision.
Procedure isCollision(X.w, Y.w)
If X < 0 Or X > ArraySize(col(), 1) Or Y < 0 Or Y > ArraySize(col(), 2) ; Or du tableau c'est un mur
ProcedureReturn #True
ElseIf col(X, Y) = #True
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure dist_between(cx,cy,dx,dy);Calcule la distance entre 2 coordonnées
ProcedureReturn Abs(cx - dx) + Abs(cy - dy)
EndProcedure
Procedure FreePath(*path.path);Libère la mémoire occupé par un chemin.
If *path<>#Null
*n.node = *path\start
While *n <> #Null
*ne = *n\suivant
FreeMemory(*n)
*n = *ne
Wend
FreeMemory(*path)
*path = #Null
EndIf
EndProcedure
;Replace le chemin à sa valeur initiale (premier noeud).
Procedure PathFirstNode(*path.path)
If *path<>#Null
*path\current = *path\start
ProcedureReturn *path\start
Else
ProcedureReturn #Null
EndIf
EndProcedure
;Renvoie 0 quand on a atteind la fin de la liste de noeud. (Utile pour faire un :)
; While PathNextNode(*my_path)
; node = PathGetCurrentNode(*my_path)
; Wend
Procedure PathNextNode(*path.path)
If *path<>#Null
If *path\current<>#Null
If *path\current\suivant <> #Null
*path\current = *path\current\suivant
ProcedureReturn *path\current
EndIf
EndIf
EndIf
ProcedureReturn #Null
EndProcedure
;Renvoie le noeud actuel du chemin
Procedure PathGetCurrentNode(*path.path)
If *path<>#Null
ProcedureReturn *path\current
Else
ProcedureReturn #Null
EndIf
EndProcedure
Procedure.s pathid(*p.pos) ; Renvoie une chaine composé de X/Y pour un accès rapide avec les maps.
ProcedureReturn Str(*p\X)+"/"+Str(*p\Y)
EndProcedure
Procedure.s getmapposition(X.w,Y.w);Même utilisation que pathid ne fonctionne pas avec une structure.
ProcedureReturn Str(X)+"/"+Str(Y)
EndProcedure
Procedure reconstruct_path(*pile, Map came_from.pos(), *current_node.pos);Finis de générer un chemin
If FindMapElement(came_from(), pathid(*current_node))
If came_from(pathid(*current_node))\X <> *current_node\X Or came_from(pathid(*current_node))\Y <> *current_node\Y
*p.node = AllocateMemory(SizeOf(node))
With *p
\suivant = *pile
\X = *current_node\X
\Y = *current_node\Y
EndWith
*path.node = reconstruct_path(*p, came_from(), came_from(pathid(*current_node)))
ProcedureReturn *path
EndIf
EndIf
*path.node = AllocateMemory(SizeOf(node))
With *path
\suivant = *pile
\X = *current_node\X
\Y = *current_node\Y
EndWith
ProcedureReturn *path
EndProcedure
;Macro utiliser par "Chemin" pour ajouter des voisins à "calculer", à la diffèrence du A*, on ne regarde pas tout les voisins.
; mais uniquement ceux qui ne sont pas des collisions.
Macro addvoisin(n, vx, vy, dg = #False)
If isCollision(vx, vy) = #False And FindMapElement(open_node(), getmapposition(vx, vy)) = #False
ajoute = #True
;Cette partie permet d'éviter que le chemin générer passe par une diagonale à côté d'une case colision
;Cette partie n'est donc pas obligatoire.
If dg <> 0
Select dg
Case 1 ; Diagonale en haut à droite, on regarde la case endesssous et à gauche si ce ne sont pas des murs.
If isCollision(vx,vy+1) = #True Or isCollision(vx-1,vy) = #True
ajoute = #False
EndIf
Case 2;Diagonale en haut à gauche.
If isCollision(vx,vy+1) = #True Or isCollision(vx+1,vy) = #True
ajoute = #False
EndIf
Case 3;Diagonale en bas à gauche.
If isCollision(vx,vy-1) = #True Or isCollision(vx+1,vy) = #True
ajoute = #False
EndIf
Case 4;Diagonale en bas à droite.
If isCollision(vx,vy-1) = #True Or isCollision(vx-1,vy) = #True
ajoute = #False
EndIf
EndSelect
EndIf
If ajoute = #True
AddElement(n)
n\X = vx
n\Y = vy
EndIf
EndIf
EndMacro
;Chemin(x1,y1, x2, y2) génère un chemin.
;La génération du chemin s'arrête automatiquemet au bout d'un certains temps fixé ici (en milliseconde) :
#CheminTemps_Max = 50
Procedure CreatePath(start_x.w, start_y.w, fin_x.w, fin_y.w)
time_start.i = ElapsedMilliseconds();Temps au début de la génération
;Génère la structure du chemin ;
Protected *path.path = AllocateMemory(SizeOf(path))
With *path
\Fin = #True
\start = #Null
\current = #Null
\X = start_x
\Y = start_y
\XFin = fin_x
\YFin = fin_y
EndWith
;*plus_proche est utilisé si l'algo au bout du #CheminTemps_Max n'a pas finis de calculer le chemin
;il va générer un parcours jusqu'à la coordonnée *plus_proche qui est la case la plus proche de celle cliqué.
Protected *plus_proche.pos_pond = AllocateMemory(SizeOf(pos_pond))
*plus_proche\Poid = 9999999
Protected NewMap open_node.pos_pond();Contient les cases à 'testé'
Protected NewMap close_node.closed_node();Contient les cases déjà testé
Protected NewMap long.i();Longueur du parcours jusqu'à la case situé dans la map.
Protected NewMap came_from.pos();Coordonné de la case précèdente à celle contenus dans la map.
Protected NewList voisin.pos_pond();Liste des 'voisins' de la case courante.
;Ajoute la première coordonnée à la liste des choses à regarder :
open_node(getmapposition(start_x, start_y))\X = start_x
open_node(getmapposition(start_x, start_y))\Y = start_y
open_node(getmapposition(start_x, start_y))\Poid = 0
long(getmapposition(start_x,start_y)) = 0
;Tant que le temps est inférieur à #CheminTemps_Max OU que la liste des cases à tester contient au moins une valeur.
While MapSize(open_node())>0 And ElapsedMilliseconds()-time_start < #CheminTemps_Max
;Permet de récupèrer la case la plus 'pertinente' :
mini = 999999
ForEach open_node()
If open_node()\Poid < mini
curx = open_node()\X
cury = open_node()\Y
mini = open_node()\Poid
EndIf
Next
;On récupère sa coordonnée, on l'enlève des chemins à tester ;
cx = open_node(getmapposition(curx, cury))\X
cy = open_node(getmapposition(curx, cury))\Y
DeleteMapElement(open_node(), getmapposition(curx, cury))
close_node(getmapposition(cx, cy))\X = 10
;Si la case à tester est la case objectif, on s'arrête et on génère le chemin :
If cx = fin_x And cy = fin_y
*cnode.pos = AllocateMemory(SizeOf(pos))
*cnode\X = fin_x
*cnode\Y = fin_y
*path\start = reconstruct_path(#Null, came_from(), *cnode)
*path\current = *path\start
FreeMemory(*plus_proche)
FreeMemory(*cnode)
FreeList(voisin())
FreeMap(open_node())
FreeMap(close_node())
FreeMap(long())
FreeMap(came_from())
ProcedureReturn *path
EndIf
;On ajoute les voisins à la case à 'tester' :
ClearList(voisin())
addvoisin(voisin(), cx + 1, cy)
addvoisin(voisin(), cx, cy - 1)
addvoisin(voisin(), cx - 1, cy)
addvoisin(voisin(), cx, cy + 1)
addvoisin(voisin(), cx + 1, cy - 1, 1)
addvoisin(voisin(), cx - 1, cy - 1, 2)
addvoisin(voisin(), cx - 1, cy + 1, 3)
addvoisin(voisin(), cx + 1, cy + 1, 4)
ForEach voisin(); Pour chaque voisin.
;Si le voisin est parmis la liste des cases déjà tester, on passe au voisin suivant ;
If FindMapElement(close_node(), Str(voisin()\X)+"/"+Str(voisin()\Y)) <> 0
Continue
EndIf
;La longueur actuel, longueur de la case de base + 1 (déplacement vers le voisin).
current_long = long(getmapposition(cx,cy)) + 1
If FindMapElement(open_node(), getmapposition(voisin()\X, voisin()\Y)) = #False
;Si pas membre des noeuds ouvert, on calcul sa distance vers la fin.
;Et on ajoute dans came_from la case courrante (pour aller sur le voisin, on est passé par la case).
dst = dist_between(voisin()\X, voisin()\Y, fin_x, fin_y)
open_node(getmapposition(voisin()\X, voisin()\Y))\Poid = dst
open_node(getmapposition(voisin()\X, voisin()\Y))\X = voisin()\X
open_node(getmapposition(voisin()\X, voisin()\Y))\Y = voisin()\Y
came_from(getmapposition(voisin()\X, voisin()\Y))\X = cx
came_from(getmapposition(voisin()\X, voisin()\Y))\Y = cy
If dst < *plus_proche\Poid;Si la case la plus proche de l'arrivé est moins bien que celle là, on l'a remplace dans la liste ;
*plus_proche\Poid = dst
*plus_proche\X = voisin()\X
*plus_proche\Y = voisin()\Y
EndIf
long(getmapposition(voisin()\X, voisin()\Y)) = current_long
ElseIf current_long < long(getmapposition(voisin()\X, voisin()\Y))
;Si il est déjà membre des noeuds ouvert, mais que la distance de la case précédente est plus courte,
;on remplace dans came_from par la nouvelle case ;
open_node(getmapposition(voisin()\X, voisin()\Y))\Poid = dist_between(voisin()\X, voisin()\Y, fin_x, fin_y)
came_from(getmapposition(voisin()\X, voisin()\Y))\X = cx
came_from(getmapposition(voisin()\X, voisin()\Y))\Y = cy
long(getmapposition(voisin()\X, voisin()\Y)) = current_long
EndIf
Next
Wend
;Si on a rien calculer avant la fin du parcours, on se content de générer en fonction de la case
; la plus proche de l'arrivé atteinte ;
pt.pos
pt\X = *plus_proche\X
pt\Y = *plus_proche\Y
*path\start = reconstruct_path(#Null, came_from(), pt)
*path\current = *path\start
*path\Fin = #False
FreeMemory(*plus_proche)
FreeList(voisin())
FreeMap(open_node())
FreeMap(close_node())
FreeMap(long())
FreeMap(came_from())
ProcedureReturn *path
EndProcedure
Code : Tout sélectionner
;Exemple utilisant l'algo A*
; stombretrooper & blendman :
Global Dim col(80,60)
IncludeFile "a_star.pb"
Macro movsnap(caseW,caseH,x,y)
m = Round(y/caseH - x/caseW,1);
n = Round(y/caseH + x/caseW,1);
x = Int((n - m)/2* caseW)
y = Int((n + m)/2* caseH)
EndMacro
Structure Stcamera
pos.point
EndStructure
Global camera.Stcamera
Structure ThreadValue
fin_calcul.a
*path_final
objx.w
objy.w
EndStructure
; Taille des cases :
#caseX = 64
#caseY = 32
;Coordonnée du joueur :
Global joueur_x, joueur_y
joueur_x = 0
joueur_y = 0
;Coordonnée du joueur au pixel près :
Global joueur_display_x, joueur_display_y
joueur_display_x = 0
joueur_display_y = 0
;Variable permettant le mouvement progressif entre 2 cases :
Global joueur_display_progressif
joueur_display_progressif = 0
; Mouvement en cours ou non :
Global mouvement_en_cours = #False
; Prochaine coordonnée du joueur :
; Utilisé pour calculer un 'path' en parallèle sans interompre le mouvement, prendra comme "départ", la prochaine case atteinte par le joueur :
Global joueur_nx, joueur_ny
;Permet la communication Thread <=> Programme
Global path_calcul.ThreadValue
path_calcul\fin_calcul = 2
*path = #Null
; Dessin des carrés & de la zone :
Procedure draw_screen()
StartDrawing(ScreenOutput())
Box(0,0,800,600,#White)
For x = 0 To 79
For y = 0 To 59
If col(x,y)
Box(x* #caseX - camera\pos\x, y* #caseY - camera\pos\y,#caseX,#caseY,#Red)
EndIf
Next
Next
Box(joueur_display_x - camera\pos\x, joueur_display_y - camera\pos\y, #caseX, #caseY, #Blue)
StopDrawing()
FlipBuffers()
EndProcedure
; Méthode qui déplace le joueur si le path contient un chemin valide :
Procedure move_player(*path.path)
If *path<>#Null
*c.node = *path\current
If *c <> #Null
joueur_display_progressif + 1
x = *c\X
y = *c\Y
While x = joueur_x And y = joueur_y And *c\suivant<>#Null
*c = *c\suivant
x = *c\X
y = *c\Y
Wend
If *c\suivant<>#Null
joueur_nx = *c\suivant\X
joueur_ny = *c\suivant\Y
EndIf
joueur_display_x = joueur_x * #caseX + (x-joueur_x)*joueur_display_progressif*#caseX/16
joueur_display_y = joueur_y * #caseY + (y-joueur_y)*joueur_display_progressif*#caseY/16
If joueur_display_progressif = 16
*path\current = *c\suivant
joueur_x = x
joueur_y = y
joueur_display_progressif = 0
If *c\suivant = #Null
freepath(*path)
*path = #Null
mouvement_en_cours = #False
EndIf
While path_calcul\fin_calcul = 0
Delay(5)
Wend
If path_calcul\fin_calcul = #True
freepath(*path)
*path = path_calcul\path_final
path_calcul\fin_calcul = 2
EndIf
Else
EndIf
EndIf
EndIf
ProcedureReturn *path
EndProcedure
; Thread permetant de calculer un path si un parcours est déjà en cours :
Procedure ThreadPath(*thread.ThreadValue)
*path_prevus = CreatePath(joueur_nx,joueur_ny, path_calcul\objx,path_calcul\objy)
path_calcul\path_final = *path_prevus
path_calcul\fin_calcul = #True
EndProcedure
;Initialisation ;
InitSprite()
OpenWindow(0,0,0,800,600,"test a start")
OpenWindowedScreen(WindowID(0), 0,0, 800, 600, 1, 0, 0)
StartDrawing(ScreenOutput())
Box(0,0,800,600,#White)
For x = 0 To 79
For y = 0 To 59
If Random(100) > 80
col(x, y) = #True
Box(x*#caseX, y*#caseY,#caseX,#caseY,#Red)
Else
col(x, y) = #False
EndIf
Next
Next
Box(cx,cy,#caseX,#caseY,#Green)
StopDrawing()
; Boucle :
Repeat
e = WindowEvent()
Delay(1)
;Detecte le fait de maintenir le click :
If e =#WM_LBUTTONDOWN
move= 1
moveok = 0
EndIf
If e =#WM_LBUTTONUP
move= 0
EndIf
If moveok<= 0
If move = 1
moveok = 60
mouse_is_click = #True
xx = (WindowMouseX(0) + camera\pos\x)/#caseX
yy = (WindowMouseY(0) + camera\pos\y)/#caseY
EndIf
Else
moveok-1
EndIf
*path = move_player(*path)
draw_screen()
;Demande de calcul de path.
If mouse_is_click = #True And joueur_display_progressif = 0
mouse_is_click = #False
If mouvement_en_cours = #True
If path_calcul\fin_calcul = 2;Il y a déjà un mouvement en cours, on créait un thread qui calcul le path sans interferer le parcours actuel ;
With path_calcul
\fin_calcul = 0
\objx = xx
\objy = yy
EndWith
CreateThread(@ThreadPath(), 0)
EndIf
Else ; On calcul le chemin :
mouse_is_click = #False
mouvement_en_cours = #True
If *path<>#Null
FreePath(*path)
EndIf
*path = CreatePath(joueur_x, joueur_y, xx,yy)
EndIf
EndIf
camera\pos\x = joueur_display_x -400
camera\pos\y = joueur_display_y -300
Until e = #PB_Event_CloseWindow
