I made an implement of JPS search with optimisations "B+P" in assembly.
This algorithm won some pathfinding competitions on grids (it's only for grid graphs)
If you want detail, an easy to grasp explanation here:
http://zerowidth.com/2013/05/05/jump-po ... ained.html
The optimisations in this paper.
http://users.cecs.anu.edu.au/~dharabor/ ... caps14.pdf
All has to be compiled with pb x86 (mine is 5.62)
DLL Hash contains specific hashtables
DLL Heap contains heapsort/queue commands
DLL JPS_Astar contains JPS pathfinding and a good regular Astar pathfinding.
I added fringe search for research purpose only ( it's very slooow https://webdocs.cs.ualberta.ca/~holte/P ... fringe.pdf )
Main test program contains a maze generator.
All files (code+DLL+exe) are in this http://dl.free.fr/oWGeNMwAz for a short time (more or less 30 days from 11/11/18)
DLL named "Hash"
Code: Select all
Structure hash
Val1.i ;+0
Val2.i ;+4
Val3.i ;+8
Val4.i ;+12
Val5.i ;+16
Val6.i ;+20
*val7 ;+24
key_unique.i ;+28
EndStructure
;cluster est composée comme suit:
;*mem nombre d'élement utilisés dans le cluster courant
;*mem+4 adresse du cluster suivant
;début des données 8 élements de 4 octets chacun
ProcedureDLL SuperiorPower2(number.i)
EnableASM
MOV ebx,[p.v_number]
BSR ecx,ebx
MOV eax,1
SAL eax,cl
cmp eax,ebx
Je _suite
SAL eax,1
!_suite:
ProcedureReturn
DisableASM
EndProcedure
;0 à c1max-1 cad pour c1max=10 0-9
ProcedureDLL Hash_New(nbS.i,nbli.i,keym.i)
*mem=0
Global nbSlot.i=SuperiorPower2(nbS)
Global datas.i=SuperiorPower2(SizeOf(hash))
Global keymax.i=keym
Global ligne.i=nbli
Global sz.i=SizeOf(hash)/SizeOf(*mem)
Global size_cluster.i=ligne*datas+SizeOf(*mem)+SizeOf(*mem) ;32*16+16 =544
Global sz.i=SizeOf(hash)/SizeOf(*mem) ;nombre de double mots copiés : 8
FreeMemory(AllocateMemory(SizeOf(*mem))) ; pour charger les librairies pb nécessaire, sinon cette ligne ne sert à rien
;create memory space for nbslots simple chained lists
*mem=AllocateMemory(nbSlot*size_cluster)
ProcedureReturn *mem
EndProcedure
ProcedureDLL Hash_Add(*mem,keyX.i,keyY.i,Val1.i,Val2.i,Val3.i,Val4.i,Val5.i,val6.i,*val7,key_unique.i)
EnableASM
MOV eax,dword [p.v_keyX] ;1
MOV ebx,dword [p.v_keyY] ;2
MUL dword [v_keymax] ;1x10000
ADD eax,ebx ;eax= 10000+2
MOV dword [p.v_key_unique],eax ;clé complete
;compression du hash en adresse
!XOr edx,edx
DIV dword [v_nbSlot] ;1002 modulo 8 = 2
IMUL edx,dword [v_size_cluster] ;2x 488 = 976
ADD edx,dword [p.p_mem] ;976 + adresse de base
MOV ebp,edx
MOV ebx,dword [p.v_key_unique]
!XOr esi,esi ;met à zero esi qui contiendra la derniere adresse de ligne vide rencontrée
!XOr edi,edi ;met à zero edi qui contiendra l'adresse du dernier cluster avec ligne vide rencontrée
!_Repea2:
MOV edx,ebp ;on sauve l'adresse de début du cluster dans edx
MOV ecx,dword [v_ligne] ;charge le nombre de ligne total d'un cluster : 16
ADD ebp,8 ;ebp pointe sur la premiere ligne de données
!_Repea3:
CMP ebx,dword [ebp+28] ;compare les 2 clées, si identiques, insere un element à la place courante, et sort
JE _suite4
CMP dword [ebp+28],0;si la clé est 0, c'est un element pret à etre réécrit, ou inexistant
JNE _ss1
CMP esi,0 ;si on a déja une adresse d'un element à reecrire, on la garde
JNE _ss1
MOV Esi, ebp ;sauvegarde l'adresse de la ligne à réécrire
MOV edi, edx ;sauvegarde l'adresse du cluster avec la ligne à réécrire
!_ss1:
ADD ebp,dword [v_datas] ;on passe à la ligne suivante
DEC Ecx
JNZ _Repea3
;on a pas trouvé la clé
MOV eax,ebp
MOV ebp,dword [edx+4] ;charge l'adresse du cluster suivant
CMP ebp,0 ;si l'adresse du cluster suivante est vide c'est que c'était le dernier
JNZ _Repea2 ;sinon on continue pour ce nouveau cluster
MOV ebp, eax
;on est dans le dernier cluster
; !CMP esi,0 ;si on a pas trouvé une adresse à ecraser
; !Je _suite3
MOV ebp,esi ;on se met à l'adresse à ecraser
MOV edx,edi ;on se met à l'adresse du cluster
!_suite3:
;On ajoute 1 au compteur de ligne du cluster
INC dword [edx]
MOV EAX,dword [edx+4] ;vérifie si on est dans le dernier cluster ou si on réécrit une valeur précédente
CMP Eax, 0
JNE _suite4
;si egale 15, on créé un nouveau cluster
MOV EAX,dword [v_ligne]
CMP EAX,dword [edx]
JNE _suite4
;crée un nouveau cluster
PUSH edx
PUSH dword [v_size_cluster]
CALL _PB_AllocateMemory@4
;CALL _PB_AllocateMemory_PURIFIER@4
CMP eax,0
JZ _fin111 ;vérifie si on a pu allouer la mémoire
POP edx
MOV dword [edx+4],eax ;sauve l'adresse du nouveau cluster dans le cluster précédent
!_suite4:
LEA esi,dword [p.v_Val1] ;ecrit les nouvelles données
MOV ecx,dword [v_sz]
LEA edi,dword [ebp]
REP MOVSD
MOV eax,ebp
!_fin111:
ProcedureReturn
DisableASM
EndProcedure
ProcedureDLL Hash_Search(*mem,keyX.i,keyY.i)
EnableASM
MOV eax,dword [p.v_keyX] ;1
MOV ebx,dword [p.v_keyY] ;2
MUL dword [v_keymax] ;1x10000
ADD eax,ebx ;eax= 10000+2
MOV esi,eax ;clé complete
;compression du hash en adresse
!XOr edx,edx
DIV dword [v_nbSlot] ;1002 modulo 8 = 2
IMUL edx,dword [v_size_cluster] ;2x 488 = 976
ADD edx,dword [p.p_mem] ;976 + adresse de base
MOV ebp,edx
MOV ebx,esi ;clé complete
!_Repea4:
MOV edx,ebp ;on sauve l'adresse de début du cluster dans edx
MOV ecx,dword [v_ligne] ;charge le nombre de ligne
ADD ebp,8
CMP Ecx,0 ;si il y a 0 ligne dans le cluster on sort
JE _fin66
!_Repea5:
CMP ebx,dword [ebp+28] ;compare les 2 clées si on la trouve, on sort
JE _suite6
ADD ebp,dword [v_datas] ;on passe à la ligne suivante
DEC Ecx
JNZ _Repea5
;on a pas trouvé la clé
MOV ebp,dword [edx+4] ;charge l'adresse du cluster suivant
CMP ebp,0
JNE _Repea4
!_fin66:
!xor eax,eax
ProcedureReturn
!_suite6:
MOV eax,ebp
ProcedureReturn
DisableASM
EndProcedure
ProcedureDLL Hash_SearchDelete(*mem,keyX.i,keyY.i)
EnableASM
MOV eax,dword [p.v_keyX] ;1
MOV ebx,dword [p.v_keyY] ;2
MUL dword [v_keymax] ;1x10000
ADD eax,ebx ;eax= 10000+2
MOV esi,eax
;compression du hash en adresse
!XOr edx,edx
DIV dword [v_nbSlot] ;1002 modulo 8 = 2
IMUL edx,dword [v_size_cluster] ;2x 488 = 976
ADD edx,dword [p.p_mem] ;976 + adresse de base
MOV dword [p.p_mem],edx ;sauvegarde l'adresse de début du cluster
MOV ebp,edx
MOV ebx,esi
MOV Eax, dword [v_datas]
!_Repea8:
MOV edx,ebp ;on sauve l'adresse de début du cluster dans edx
MOV ecx,dword [v_ligne] ;charge le nombre totale de ligne ds un cluster
ADD ebp,8
!_Repea10:
NOP
CMP ebx,dword [ebp+28] ;compare les 2 clées si on la trouve, on sort
JE _suite8
ADD ebp,eax ;on passe à la ligne suivante
DEC Ecx
JNZ _Repea10
;on a pas trouvé la clé
MOV edi,edx ;sauvegarde l'adresse du cluster précédent
MOV ebp,dword [edx+4] ;charge l'adresse du cluster suivant
CMP ebp,0
JNE _Repea8
!xor eax,eax ;pas trouvé l'élement à effacer, renvoie 0
ProcedureReturn
!_suite8:
DEC dword [edx] ;retire une ligne au compteur de ligne
MOV dword [ebp+28],0; indique que la ligne est effacée en mettant sa clée à 0
MOV ebx,dword [edx];charge le nombre de ligne
CMP ebx,0
JNE _suite10 ;si le cluster n'est pas vide, on sort
MOV ecx,dword [edx+4] ;charge l'adresse du cluster suivant
CMP ecx,0
JE _suite10 ;si l'adresse du prochain cluster est zero, on sort
MOV eax, dword [p.p_mem]
CMP eax,edx
JE _suite10 ;si on est au premier cluster, on sort
MOV dword [edi+4],ecx ;met l'adresse du cluster suivant dans le cluster précédent
;efface le cluster
PUSH edx
CALL _PB_FreeMemory@4
;CALL _PB_FreeMemory_PURIFIER@4
!_suite10:
MOV eax,ebp
ProcedureReturn
DisableASM
EndProcedure
ProcedureDLL Hash_Free(*mem)
EnableASM
MOV ebx,dword [v_nbSlot]
dec ebx
!_Repea86:
MOV ebp,ebx
IMUL ebp,dword [v_size_cluster]
Add ebp, dword [p.p_mem] ;adresse de base
!_Repea81:
MOV esi,dword [ebp+4] ;charge l'adresse du prochain cluster
push ebp
CALL _PB_FreeMemory@4 ;efface le cluster courant
cmp esi,0
JE _Suiv81 ;si c'était le dernier, on sort
mov ebp,esi ; on passe au suivant
JMP _Repea81
!_Suiv81:
dec ebx
MOV ecx,-1
CMP ebx,ecx
Jne _Repea86
!xor eax,eax
ProcedureReturn
DisableASM
EndProcedure
Procedure DisplayTable(*mem)
Debug " "
For i=0 To nbslot-1 ;next slot
*index=i*size_cluster+*mem
j=0
Repeat
Debug "Cluster :"+Str(i)+"+"+Str(j)
Debug Hex(PeekI(*index))+ " "+Hex(PeekI(*index+4))
*index1.hash=*index+8
For k=0 To ligne-1
Debug Hex(*index1)+" "+Hex(*index1\Val1)+" "+Hex(*index1\Val2)+" "+Hex(*index1\Val3)+" "+Hex(*index1\Val5)+" "+Hex(*index1\val6)+" "+Hex(*index1\val7)+" "+Hex(*index1\key_unique)
*index1+datas ;next element
Next k
Debug " "
*index=PeekI(*index+4):j+1
Until *index=0
Next i
EndProcedure
Code: Select all
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
#octets=4
CompilerElse
#octets=8
CompilerEndIf
Structure mem
Dat.i
EndStructure
ProcedureDLL Heap_New()
*mem.mem=AllocateMemory(#octets)
If *mem=0:MessageRequester("Error","Heap Final\newheap() n'a pu allouer la mémoire"):EndIf
*mem\Dat=0;nombre d'éléments dans le tas: 0
ProcedureReturn *mem
EndProcedure
ProcedureDLL Heap_Clear(heap.i)
*mem.mem=ReAllocateMemory(heap,#octets)
If *mem=0:MessageRequester("Error","clearheap n'a pu réduire la mémoire"):EndIf
*mem\Dat=0;nombre d'éléments dans le tas: 0
ProcedureReturn *mem
EndProcedure
ProcedureDLL Heap_Free(*mem)
FreeMemory(*mem)
EndProcedure
ProcedureDLL Heap_AddElement(*memo,*key)
EnableASM
MOV ebp, dword [p.p_memo]
MOV ebx, dword [ebp] ;charge le nombre d'element
INC ebx ;nb element+1
MOV dword [ebp],ebx ;nb element+1
LEA eax,[ebx*4+4] ;calcul le nombre d'octets à assigner
PUSH ebx
PUSH eax ;nombre d'octets à assigner en mémoire
PUSH ebp ;adresse de début
CALL _PB_ReAllocateMemory@8 ;nouvelle adresse dans eax
POP ebx
CMP eax,0
JE _fin ;erreur renvoie 0
MOV dword [p.p_memo],eax
LEA ecx, [eax+ebx*4] ;vérifier si ebx est toujours à la même valeur
MOV edx, dword [p.p_key]
MOV dword [ecx],edx ;mets l'adresse clé en fin de tas
;eax = memoire de base
;ebx = numero element courant
!boucle0:
LEA edi, [eax+ebx*4] ;edi= actuel
SHR ebx,1 ;>>1
LEA ebp, [eax+ebx*4] ;ebp = père
CMP ebx,0 ;si courant <1
JZ _fin2
MOV ecx, dword [ebp]
PUSH ecx
MOV ecx, dword [ecx];PeekI(PeekI(*pere))
MOV edx, dword [edi]
PUSH edx
CMP ecx,dword [edx] ;PeekI(PeekI(*actuel))
JB _fin1 ;sort si inférieur strictement
POP dword [ebp]
POP dword [edi]
JMP boucle0
;courant.i=nb
;*mem+courant*#octets
;*mem\Dat=*key
;;PokeI(*mem+courant*#octets,*key) ;met l'adresse de la valeur en fin de tas
; Repeat
; *actuel.mem=*mem+courant*#octets
; courant=courant>>1
; *pere.mem=*mem+courant*#octets ;i/2
; If courant<1 Or PeekI(PeekI(*pere))<PeekI(PeekI(*actuel)):Break:EndIf
; swap1.i=*pere\Dat
; swap2.i=*actuel\Dat
; *pere\Dat=swap2 ;PokeI(*pere,swap2)
; *actuel\Dat=swap1 ;PokeI(*actuel,swap1)
; ForEver
!_fin:
ProcedureReturn
!_fin1:
POP ecx
POP ecx
ProcedureReturn *memo
!_fin2:
ProcedureReturn *memo
DisableASM
EndProcedure
ProcedureDLL Heap_Heapify(*mem.integer,*mem1);(*mem,*mem1)
nb.i=*mem\i
For i=1 To nb
*mem2.integer=*mem+#octets*i
If *mem2\i=*mem1:Break:EndIf
Next i
Repeat
L.i=i<<1 ;gauche
R.i=L+1 ;droit
*mem2.integer=*mem+L*#octets
*mem3.integer=*mem+i*#octets
*mem4.integer=*mem2\i
*mem5.integer=*mem3\i
If L<=nb And *mem4\i<*mem5\i
Min=L
Else
Min=i
EndIf
*mem2.integer=*mem+R*#octets
*mem3.integer=*mem+Min*#octets
*mem4.integer=*mem2\i
*mem5.integer=*mem3\i
If R<=nb And *mem4\i<*mem5\i
Min=R
EndIf
If Min=i:Break:EndIf
*mem2.integer=*mem+i*#octets
*mem3.integer=*mem+Min*#octets
swap1.i=*mem2\i
swap2.i=*mem3\i
*mem2\i=swap2
*mem3\i=swap1
i=Min
ForEver
; EnableASM
; MOV ebp, dword [p.p_memo]
; MOV ecx, [ebp] ;ecx= nb
; MOV edx,dword [p.p_mem1]
; MOV ebx,1
; ;*mem.mem=*memo
; ;nb.i=*mem\Dat
; !_boucle20:
; LEA eax,[ebp+ebx*4]
; CMP dword [eax],edx
; JE _sortir1
; INC ebx
; CMP ebx,ecx
; JNE _boucle20
; !_sortir1:
; MOV eax, ecx
;
;
; ;L =ecx
; ;R = edx
; ;mem0 = ebp
; ;Min = esi
; ;nb = eax
;
; ;MOV ebx,1 ;i = ebx
; !_boucle10:
; PUSH eax ;sauve nb
; LEA ecx, [ebx*2] ;L= i<<1
; LEA edx, [ecx+1] ;R= L+1
; CMP ecx,eax ;L<=nb
; JA _Su10 ;saute si supérieur
;
; LEA edi,[ebp+ecx*4] ;*mem0+L*#octets
; MOV edi,dword [edi];PeekI(*mem0+L*#octets)
; MOV edi,[edi];PeekI(PeekI(*mem0+L*#octets))
; LEA eax,[ebp+ebx*4] ;*mem0+i*#octets
; MOV eax,dword [eax];PeekI(*mem0+i*#octets)
; MOV eax,dword [eax];PeekI(PeekI(*mem0+i*#octets))
; CMP edi,eax
; JAE _Su10 ;saute si supérieur ou egal
;
; MOV esi,ecx;Min=L
; JMP _su30
;
; !_Su10:
; MOV esi,ebx ;Min=i
;
; !_su30:
; POP eax ;récupère nb
; PUSH eax ;sauve nb
; CMP edx,eax ;R<=nb
; JA _Su20 ;saute si supérieur
;
; LEA edi,[ebp+edx*4] ;*mem0+R*#octets
; MOV edi,[edi];PeekI(*mem0+R*#octets)
; MOV edi,[edi];PeekI(PeekI(*mem0+R*#octets))
; LEA eax,[ebp+esi*4] ;*mem0+i*#octets
; MOV eax,[eax];PeekI(*mem0+i*#octets)
; MOV eax,[eax];PeekI(PeekI(*mem0+i*#octets))
; CMP edi,eax
; JAE _Su20;saute si superieur ou egale
;
; MOV esi,edx ;Min=R
;
; !_Su20:
; POP eax ;récupère nb
;
; CMP esi,ebx ;If Min=i:Break:EndIf
; JE _fin110
;
; PUSH eax ;sauve eax
;
; LEA eax,[ebp+ebx*4] ;*mem0+i*#octets
; PUSH dword [eax] ;PeekI(*mem0+i*#octets)
; LEA edi,[ebp+esi*4] ;*mem0+Min*#octets
; PUSH dword [edi];PeekI(*mem0+Min*#octets,swap1)
; LEA eax,[ebp+ebx*4]
; POP dword [eax]; PokeI(*mem0+i*#octets,swap2)
; POP dword [edi]; PokeI(*mem0+Min*#octets,swap1)
;
; POP eax ;récupère eax
; MOV ebx,esi; i=Min
; JMP _boucle10 ; ForEver
;
;
;
; !_fin110:
; ProcedureReturn *Minimum
; !_fin100:
; ProcedureReturn ;retourne 0
;
; DisableASM
EndProcedure
ProcedureDLL Heap_GetMin(*mem0) ;retourne zero si vide, sinon l'adresse de l'element minimum.
*minimum=0
EnableASM
MOV ebp, dword [p.p_mem0] ;ebp=*mem0
MOV eax, dword [ebp] ;Eax=nb
CMP Eax,0
JZ _fin10 ;tas vide car nb element=0
MOV ebx,dword [ebp+4] ;ebx= adresse minimum à renvoyer
MOV dword [p.p_minimum],ebx ;adresse sauvegardée
LEA ecx, [ebp+eax*4]
PUSH dword [ecx]
POP dword [ebp+4]
DEC dword [ebp] ;PokeI(*mem0,nb-1)
DEC eax ;nb-1 encore
;L =ecx
;R = edx
;mem0 = ebp
;Min = esi
;nb = eax
MOV ebx,1 ;i = ebx
!_boucle1:
PUSH eax ;sauve nb
LEA ecx, [ebx*2] ;L= i<<1
LEA edx, [ecx+1] ;R= L+1
CMP ecx,eax ;L<=nb
JA _Su1 ;saute si supérieur
LEA edi,[ebp+ecx*4] ;*mem0+L*#octets
MOV edi,dword [edi];PeekI(*mem0+L*#octets)
MOV edi,[edi];PeekI(PeekI(*mem0+L*#octets))
LEA eax,[ebp+ebx*4] ;*mem0+i*#octets
MOV eax,dword [eax];PeekI(*mem0+i*#octets)
MOV eax,dword [eax];PeekI(PeekI(*mem0+i*#octets))
CMP edi,eax
JAE _Su1 ;saute si supérieur ou egal
MOV esi,ecx;Min=L
JMP _su3
!_Su1:
MOV esi,ebx ;Min=i
!_su3:
POP eax ;récupère nb
PUSH eax ;sauve nb
CMP edx,eax ;R<=nb
JA _Su2 ;saute si supérieur
LEA edi,[ebp+edx*4] ;*mem0+R*#octets
MOV edi,[edi];PeekI(*mem0+R*#octets)
MOV edi,[edi];PeekI(PeekI(*mem0+R*#octets))
LEA eax,[ebp+esi*4] ;*mem0+i*#octets
MOV eax,[eax];PeekI(*mem0+i*#octets)
MOV eax,[eax];PeekI(PeekI(*mem0+i*#octets))
CMP edi,eax
JAE _Su2;saute si superieur ou egale
MOV esi,edx ;Min=R
!_Su2:
POP eax ;récupère nb
CMP esi,ebx ;If Min=i:Break:EndIf
JE _fin11
PUSH eax ;sauve eax
LEA eax,[ebp+ebx*4] ;*mem0+i*#octets
PUSH dword [eax] ;PeekI(*mem0+i*#octets)
LEA edi,[ebp+esi*4] ;*mem0+Min*#octets
PUSH dword [edi];PeekI(*mem0+Min*#octets,swap1)
LEA eax,[ebp+ebx*4]
POP dword [eax]; PokeI(*mem0+i*#octets,swap2)
POP dword [edi]; PokeI(*mem0+Min*#octets,swap1)
POP eax ;récupère eax
MOV ebx,esi; i=Min
JMP _boucle1 ; ForEver
!_fin11:
ProcedureReturn *Minimum
!_fin10:
ProcedureReturn ;retourne 0
DisableASM
EndProcedure
ProcedureDLL Heap_Size(*mem)
ProcedureReturn PeekI(*mem)
EndProcedure
Code: Select all
;*******************************
;* Jump Point Search (B+P optimisation)
;* By Fig 2017
;* v1.1
;*******************************
;structures JPS
Structure Area11
f.l
g.l
x.l
y.l
open.l
sens.l
*parent
key_unique.l
EndStructure
Structure pt
x.l
y.l
EndStructure
Structure pt2
x1.l
x2.l
y.l
EndStructure
Structure pt3
x.l
y.l
g.l
EndStructure
Structure spt
List spot.pt3()
EndStructure
;structure A*
Structure A_1
*Hash_mem
*Heap_mem
EndStructure
Structure A_2
*area_horizontal
*area_vertical
largeur.l
ix.l
EndStructure
Import "Heap.lib"
Heap_New() ;newmem=Heap_New()
Heap_Clear(*mem) ;newmem=Heap_Clear(*mem)
Heap_Free(*mem)
Heap_AddElement(*mem,*key) ;newmem=Heap_AddElement(*mem,*key)
Heap_GetMin(*mem) ;Adresse element minimum=Heap_GetMin(*mem)
Heap_Size(*mem)
Heap_Heapify(*mem,*mem1)
EndImport
Import "Hash.lib"
Hash_New(nbSlot.l,nbligne.l,keymax.l) ;Newmem=
Hash_Add(*mem,keyX.l,keyY.l,f.l,g.l,x.l,y.l,open.l,Val6.l,*parent,key_unique.l) ;Adress of the element added=
Hash_Search(*mem,keyX.l,keyY.l) ;adress of the element found
Hash_SearchDelete(*mem,keyX.l,keyY.l)
Hash_Free(*mem)
SuperiorPower2(number.i)
EndImport
;liste des différentes zones créés
Global NewList Area.A_2()
Global largeur.l
Global *area_horizontal
Global *area_vertical
Global ix.l
Macro distance(x1,y1,x2,y2)
;manathan
(Abs(x2-x1)+Abs(y2-y1))*10
;euclidean
;Sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1))*10
EndMacro
Macro AddNode(sens)
Cgg.l=distance(cx,cy,cxx,cyy)+*adr\g
*adr2.Area11=Hash_Search(*Hash_mem,cxx,cyy)
If *adr2 And *adr\open=1;si le noeud est ouvert on le modifie
If *adr2\g>Cgg
*adr2\g=Cgg
*adr2\f=Cgg+distance(cxx,cyy,gx,gy)
*adr2\parent=*adr
Heap_Heapify(*Heap_mem,*adr2)
EndIf
ElseIf *adr2 And *adr2\open=2 ;si le noeud est fermé
If *adr2\g>Cgg
*adr2\g=Cgg
*adr2\f=Cgg+distance(cxx,cyy,gx,gy)
*adr2\open=1
*adr2\parent=*adr
*adr2\x=Cxx
*adr2\y=Cyy
*Heap_mem=Heap_AddElement(*Heap_mem,*adr2)
EndIf
Else ;le noeud n'a jamais été visité
*adr2.Area11=Hash_add(*Hash_mem,cxx,cyy,Cgg+distance(cxx,cyy,gx,gy),Cgg,Cxx,Cyy,1,sens,*adr,#NUL)
*Heap_mem=Heap_AddElement(*Heap_mem,*adr2)
EndIf
EndMacro
Macro A_AddNode
If i=0 Or j=0
Cgg.l=10+*adr\g
Else
Cgg.l=14+*adr\g
EndIf
*adr2.Area11=Hash_Search(*Hash_mem,cxx,cyy)
If *adr2 And *adr\open=1;si le noeud est ouvert on le modifie
If *adr2\g>Cgg
*adr2\g=Cgg
*adr2\f=Cgg+distance(cxx,cyy,gx,gy)
*adr2\parent=*adr
Heap_Heapify(*Heap_mem,*adr2)
EndIf
ElseIf *adr2 And *adr2\open=2 ;si le noeud est fermé
If *adr2\g>Cgg
*adr2\g=Cgg
*adr2\f=Cgg+distance(cxx,cyy,gx,gy)
*adr2\open=1
*adr2\parent=*adr
*adr2\x=Cxx
*adr2\y=Cyy
*Heap_mem=Heap_AddElement(*Heap_mem,*adr2)
EndIf
Else ;le noeud n'a jamais été visité
*adr2.Area11=Hash_add(*Hash_mem,cxx,cyy,Cgg+distance(cxx,cyy,gx,gy),Cgg,Cxx,Cyy,1,#NUL,*adr,#NUL)
*Heap_mem=Heap_AddElement(*Heap_mem,*adr2)
EndIf
EndMacro
ProcedureDLL DeleteArea(*Area)
If ChangeCurrentElement(Area(),*area)
ProcedureReturn DeleteElement(Area(),1)
Else
ProcedureReturn 0
EndIf
EndProcedure
ProcedureDLL DeleteWall(x.l,y.l,*Area)
ChangeCurrentElement(Area(),*Area)
largeur=Area()\largeur
*area_horizontal=area()\area_horizontal
*area_vertical=area()\area_vertical
ix=area()\ix
If x=0 Or y=0 Or x=ix-1 Or y=ix-1:MessageRequester("Error","You can not delete a wall on x=0,y=0 or x="+Str(ix-1)+" y="+Str(ix-1)):ProcedureReturn 0:EndIf
EnableASM
MOV ebx,dword [p.v_x]
MOV eax,dword [p.v_y]
MOV ecx,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p_area_horizontal] ;adresse du tableau
MUL ecx
PUSH eax ;eax=y*nbligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le rang des bits
MOV ebp,7
SUB ebp,edx
MOV edx,ebp
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD eax,esi ;eax+adress de base
BTR dword [eax],edx ;met le bit du reste à 0
MOV ebx,dword [p.v_y]
MOV eax,dword [p.v_x]
MOV ecx,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p_area_vertical] ;adresse du tableau
MUL ecx
PUSH eax ;eax=y*nbligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le rang des bits
MOV ebp,7
SUB ebp,edx
MOV edx,ebp
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD eax,esi ;eax+adress de base
BTR dword [eax],edx ;met le bit du reste à 0
ProcedureReturn
DisableASM
EndProcedure
ProcedureDLL.l IsWall(x.l,y.l,*Area)
ChangeCurrentElement(Area(),*Area)
largeur=Area()\largeur
*area_horizontal=area()\area_horizontal
*area_vertical=area()\area_vertical
ix=area()\ix
EnableASM
MOV ebx,dword [p.v_x]
MOV eax,dword [p.v_y]
MOV ecx,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p_area_horizontal] ;adresse du tableau
MUL ecx
PUSH eax ;eax=y*nbligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le rang des bits
MOV ebp,7
SUB ebp,edx
MOV edx,ebp
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD eax,esi ;eax+adress de base
BT dword [eax],edx ;test le bit
JC _mur_present
XOR eax,eax
ProcedureReturn
!_mur_present:
MOV eax,1
ProcedureReturn
EndProcedure
ProcedureDLL AddWall(x.l,y.l,*Area)
ChangeCurrentElement(Area(),*Area)
largeur=Area()\largeur
*area_horizontal=area()\area_horizontal
*area_vertical=area()\area_vertical
ix=area()\ix
EnableASM
MOV ebx,dword [p.v_x]
MOV eax,dword [p.v_y]
MOV ecx,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p_area_horizontal] ;adresse du tableau
MUL ecx
PUSH eax ;eax=y*nbligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le rang des bits
MOV ebp,7
SUB ebp,edx
MOV edx,ebp
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD eax,esi ;eax+adress de base
BTS dword [eax],edx ;met le bit du reste à 1
MOV ebx,dword [p.v_y]
MOV eax,dword [p.v_x]
MOV ecx,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p_area_vertical] ;adresse du tableau
MUL ecx
PUSH eax ;eax=y*nbligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le rang des bits
MOV ebp,7
SUB ebp,edx
MOV edx,ebp
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD eax,esi ;eax+adress de base
BTS dword [eax],edx ;met le bit du reste à 1
ProcedureReturn
DisableASM
EndProcedure
ProcedureDLL CreateArea(size.l)
If SuperiorPower2(size)<>size:MessageRequester("Error","The new area's size has to be a power of 2 !! ( ie 16,32,64,128,256,512,1024 etc... )"):EndIf
AddElement(Area())
Area()\ix=size
sizX=size>>3;divise par 8 bits
sizY=size+2
Area()\largeur=sizX ;nombre d'octets en largeur
Area()\area_horizontal=AllocateMemory(sizX*sizY)+sizX
Area()\area_vertical=AllocateMemory(sizX*sizY)+sizX
If Area()\area_horizontal=0 Or Area()\area_vertical=0:MessageRequester("error","can't allocate memory to CreateArea"):EndIf
;mets les murs autours
For i=0 To size-1
AddWall(i,0,@Area())
AddWall(i,size-1,@Area())
AddWall(0,i,@Area())
AddWall(size-1,i,@Area())
Next i
Debug "adresse du jeu "+Str(Area()\area_horizontal)+" à "+Str(Area()\area_horizontal+sizx*sizy)
ProcedureReturn @Area()
EndProcedure
Procedure.l droite_Fast(x.l,y.l,*area_1,Gx.l,Gy.l)
Debug "adresse "+ Str(*area_1+y*largeur+Int(x/8))
EnableASM
MOV ebx,dword [p.v_x]
MOV eax,dword [p.v_y]
DEC eax ;passe à la ligne au dessus
MOV edi,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p.p_area_1]
MUL edi
PUSH eax ;eax=y*nbligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le nombre de bit à décaler
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD esi,eax ;esi=eax+adress de base
MOV ecx,edx ;ecx reste cad nb de bit
XOR ebp,ebp ;met à zero le total de déplacement
!_bouclette:
;Au dessus EAX
PUSH ebp ;sauvegarde le déplacement total
PUSH esi ;sauvegarde esi pour boucler sur l'adresse de l'emplacement... Vérifier si nécessaire !!!!!
MOV eax,dword [esi] ;charge les 32 bits au dessus
BSWAP eax ;remets les octets dans l'ordre
SHL eax,CL ;décale jusqu'a ce qu'on soit aligné pour la ligne centrale
;function forced
MOV ebx,eax
NOT ebx ; !B
SHR eax,1 ;>>1
AND eax,ebx ;B>>1 & !B
SHR eax,cl ;fait disparaitre le dernier bit
SHL eax,cl
;Courant EDX
LEA esi,[esi+edi] ;passe à la ligne centrale
MOV edx,dword [esi] ;charge les 32 bits des murs
BSWAP edx ;remets les octets dans l'ordre
SHL edx,CL ;décale jusqu'a ce qu'on soit aligné pour la ligne centrale
;Au dessous EBX
LEA esi,[esi+edi] ;passe à la ligne en dessous
MOV ebx,dword [esi] ;charge les 32 bits des murs
BSWAP ebx ;remets les octets dans l'ordre
SHL ebx,CL ;décale jusqu'a ce qu'on soit aligné pour la ligne centrale
;function forced
MOV ebp,ebx
NOT ebp ; !B
SHR ebx,1 ;>>1
AND ebx,ebp ;B>>1 & !B
SHR ebx,cl ;fait disparaitre le dernier bit
SHL ebx,cl
OR Eax,EDX
OR Eax,EBX
BSR Eax,eax ;de gauche à droite, rang du 1er bit rencontré. 4=>2 ; 2=>1 ; 1=>0
JNZ _HITWALL ;on va sortir car il y a un mur quelque part
;on passe au DWord suivant
POP esi ;recupere esi
POP ebp ;recupere emplacement total
MOV ebx,31
SUB ebx,ecx
ADD ebp,ebx ;rajoute au total l'emplacement
LEA esi, [esi+3] ;passe aux 32 bits suivant en ajoutant 3 octets
MOV ecx,7 ;décale de 7 bits
JMP _bouclette
!_HITWALL:
POP esi
POP ebp
BSR edx,edx ;edx Bn pour 1000 renvoie la position du 1er bit rencontré en lisant de gauche à droite la ligne centrale
CMP eax,edx
JBE _DeadEnd ;si eax plus petit ou égal, DeadEnd
;Jump Point découvert
MOV ebx,30
SUB ebx,eax
ADD ebx,ebp ;rajoute au total l'emplacement
ADD ebx,dword [p.v_x] ;ebx contient la coordonnée X du jump point
MOV ecx,dword [p.v_y]
MOV edx,dword [p.v_Gy]
CMP ecx,edx
JNE _renvoi1 ; si y goal et y différent, on renvoie le jump point trouvé dans eax
MOV ecx, dword [p.v_Gx]
MOV eax,dword [p.v_x]
CMP eax,ecx
JA _renvoi1 ;si X > goal X on sort en renvoyant le Jump Point trouvé dans eax
CMP ebx,ecx
JB _renvoi1 ;si jump point X < Goal X on sort
MOV eax, ecx;on bloque sur X Goal car il a été trouvé
ProcedureReturn
!_renvoi1:
MOV eax,ebx
;renvoie l'emplacement du jump point
ProcedureReturn
!_DeadEnd:
MOV ebx,31
SUB ebx,eax
ADD ebx,ebp ;rajoute au total l'emplacement
JZ _on_est_sur_un_mur
ADD ebx,dword [p.v_x] ;coordonnée du mur
MOV ecx,dword [p.v_y]
MOV edx,dword [p.v_Gy]
CMP ecx,edx
JNE _renvoi2 ; si y goal et y courant différent, on sort
MOV ecx, dword [p.v_Gx]
MOV eax,dword [p.v_x]
CMP eax,ecx
JA _renvoi2 ;si x>goal X on sort
CMP ebx,ecx
JB _renvoi2 ;si WallX < Goal X on sort
MOV eax, ecx;on bloque sur le Goal
ProcedureReturn
!_renvoi2:
XOR eax,eax ;retourne zero car deadend
ProcedureReturn
!_on_est_sur_un_mur:
MOV eax,dword [v_ix]
ProcedureReturn
DisableASM
EndProcedure
Procedure.l gauche_Fast(x.l,y.l,*area_1,Gx.l,Gy.l)
Debug "adresse "+ Str(*area_1+y*largeur+Int(x/8))
EnableASM
MOV ebx,dword [p.v_x]
MOV eax,dword [p.v_y]
DEC eax ;passe à la ligne au dessus
MOV edi,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p.p_area_1]
MUL edi
PUSH eax ;eax=y*largeur_ligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le nombre de bit à décaler
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD esi,eax ;esi=eax+adress de base
SUB esi,3 ;recule de 3 octets
MOV ecx,7 ;reste ecx et edx complément à 7
SUB ecx,edx
XOR ebp,ebp ;met à zero le total de déplacement
!_bouclette2:
;Au dessus EAX
PUSH ebp ;sauvegarde le déplacement total
PUSH esi ;sauvegarde esi pour boucler sur l'adresse de l'emplacement... Vérifier si nécessaire !!!!!
MOV eax,dword [esi] ;charge les 32 bits au dessus
BSWAP eax ;remets les octets dans l'ordre
SHR eax,CL ;décale jusqu'a ce qu'on soit aligné pour la ligne du dessus
MOV ebx,eax
NOT ebx ; !B
SHL eax,1 ;<<1
AND eax,ebx ;B<<1 & !B
SHL eax,cl
SHR eax,cl
;Courant EDX
LEA esi,[esi+edi] ;passe à la ligne centrale
MOV edx,dword [esi] ;charge les 32 bits des murs
BSWAP edx ;remets les octets dans l'ordre
SHR edx,CL ;décale jusqu'a ce qu'on soit aligné pour la ligne centrale
;Au dessous EBX
LEA esi,[esi+edi] ;passe à la ligne en dessous
MOV ebx,dword [esi] ;charge les 32 bits des murs
BSWAP ebx ;remets les octets dans l'ordre
SHR ebx,CL ;décale jusqu'a ce qu'on soit aligné pour la ligne du dessous
MOV ebp,ebx
NOT ebp ; !B
SHL ebx,1 ;<<1
AND ebx,ebp ;B<<1 & !B
SHL ebx,cl
SHR ebx,cl
OR Eax,EDX
OR Eax,EBX
BSF Eax,eax ;de droite à gauche, rang du 1er bit rencontré.
JNZ _HITWALL2 ;on va sortir car il y a un mur quelque part
;on passe au DWord suivant
POP esi ;recupere esi
POP ebp ;recupere emplacement total
MOV ebx,31
SUB ebx,ecx
ADD ebp,ebx ;rajoute au total l'emplacement
LEA esi, [esi-3] ;passe aux 32 bits suivant en ajoutant 3 octets
MOV ecx,7 ;décale de 7 bits
JMP _bouclette2
!_HITWALL2:
POP esi
POP ebp
BSF edx,edx ;edx Bn pour 1000 renvoie la position du 1er bit rencontré en lisant de droite à gauche la ligne centrale
JNZ _suite556 ;si ligne centrale vide, edx reste à 0, ZF mis à 1 néanmoins.
MOV edx,255 ;mets à l'infini
!_suite556: ;compare le plus grand eax et edx
CMP eax,edx
JAE _DeadEnd2 ;si eax plus petit ou égal, DeadEnd
DEC EAX
ADD eax,ebp ;rajoute au total l'emplacement
MOV ebx,dword [p.v_x] ;ebx contient la coordonnée X du jump point
SUB ebx,eax ;ebx contient la coordonnée X du jump point
;vérifie si on a trouvé le goal entre temps
MOV ecx,dword [p.v_y]
MOV edx,dword [p.v_Gy]
CMP ecx,edx
JNE _renvoi4 ; si y goal et y différent, on renvoie le jump point trouvé dans eax
MOV ecx, dword [p.v_Gx]
MOV eax,dword [p.v_x]
CMP eax,ecx
JB _renvoi4 ;si X < goal X on sort en renvoyant le Jump Point trouvé dans eax
CMP ebx,ecx
JA _renvoi4 ;si jump point X < Goal X on sort
MOV eax, ecx;on bloque sur X Goal car il a été trouvé
ProcedureReturn
!_renvoi4:
MOV eax,ebx
;renvoie l'emplacement du jump point
ProcedureReturn
!_DeadEnd2:
;DEC eax INc ptetre ?
ADD eax,ebp ;rajoute au total l'emplacement
JZ _on_est_sur_un_mur2
MOV ebx,dword [p.v_x]
SUB ebx,eax ;coordonnée du mur
;vérifie si on a trouvé le goal
MOV ecx,dword [p.v_y]
MOV edx,dword [p.v_Gy]
CMP ecx,edx
JNE _renvoi3 ; si y goal et y courant différent, on sort
MOV ecx, dword [p.v_Gx]
MOV eax,dword [p.v_x]
CMP eax,ecx
JB _renvoi3 ;si x<goal X on sort
CMP ebx,ecx
JA _renvoi3 ;si WallX > Goal X on sort
MOV eax,ecx ;on bloque sur le Goal
ProcedureReturn
!_renvoi3:
XOR eax,eax ;retourne zero car deadend
ProcedureReturn
!_on_est_sur_un_mur2:
MOV eax,dword [v_ix]
ProcedureReturn
DisableASM
EndProcedure
Procedure Is_Wall(x.l,y.l)
EnableASM
MOV ebx,dword [p.v_x]
MOV eax,dword [p.v_y]
MOV ecx,dword [v_largeur] ;nb d'octets par ligne
MOV esi,dword [p_area_horizontal] ;adresse du tableau
MUL ecx
PUSH eax ;eax=y*nbligne
XOR edx,edx
MOV eax,ebx
MOV ebp,8
DIV ebp ;divise par x/8 eax resultat, edx reste cad le rang des bits
MOV ebp,7
SUB ebp,edx
MOV edx,ebp
POP ebx ;ebx=y*nbligne
ADD eax,ebx ;eax=x/8+y*nbligne
ADD eax,esi ;eax+adress de base
BT dword [eax],edx ;test le bit
JC _mur_present2
XOR eax,eax
ProcedureReturn
!_mur_present2:
MOV eax,1
ProcedureReturn
EndProcedure
ProcedureDLL.l JPS_ONLY(sx.l,sy.l,gx.l,gy.l,*Area,*p.spt)
ChangeCurrentElement(Area(),*Area)
largeur=Area()\largeur
*area_horizontal=area()\area_horizontal
*area_vertical=area()\area_vertical
ix=area()\ix
*Hash_mem=Hash_New(Int(ix/10),15,ix)
ClearList(*p\spot())
*Heap_mem=Heap_New()
; first node (start node) in open list
*a=Hash_Add(*Hash_mem,Sx,Sy,distance(Sx,Sy,gx,gy),0,sx,sy,1,#NUL,0,#NUL)
If *a=0:MessageRequester("debug","l'élement n'a pas pu être ajouté à la Hash_table "):EndIf
*Heap_mem=Heap_AddElement(*Heap_mem,*a);@Area(Sx,Sy))
If *Heap_mem=0:MessageRequester("debug","Un element n'a pas pu etre ajouté au tas"):EndIf
While Heap_Size(*Heap_mem)
;get the minimum f node
*adr.area11=Heap_GetMin(*Heap_mem)
Cx=*adr\x:Cy.l=*adr\y:Cg.l=*adr\g:sens=*adr\sens
If cx=Gx And cy=Gy:Break:EndIf
Debug "noeud examiné "+Str(cx)+"/"+Str(cy),1
;{ RIGHT
If sens<>2
x1=cx+1:y1=cy
cxx=droite_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
Debug Str(cxx)+"\"+Str(cyy)
If cxx And cxx<>ix
AddNode(1)
EndIf
EndIf
;LEFT
If sens<>1
x1=cx-1:y1=cy
cxx=gauche_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
Debug Str(cxx)+"\"+Str(cyy)
If cxx And cxx<>ix
AddNode(2)
EndIf
EndIf
;down
If sens<>4
x1=cx:y1=cy+1
cyy=droite_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
Debug Str(cxx)+"\"+Str(cyy)
If cyy And cyy<>ix
AddNode(3)
EndIf
EndIf
;UP
If sens<>3
x1=cx:y1=cy-1
cyy=gauche_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
Debug Str(cxx)+"\"+Str(cyy)
If cyy And cyy<>ix
AddNode(4)
EndIf
EndIf
;diagonal down-right
If sens<>8
x1=cx:y1=cy
Repeat
If is_wall(x1+1,y1) And is_wall(x1,y1+1):Break:EndIf
x1+1:y1+1
;right
cxx=droite_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
Debug Str(cxx)+"\"+Str(cyy)
If cxx
If cxx=ix:Break:EndIf
AddNode(5)
EndIf
;down
cyy=droite_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
Debug Str(cxx)+"\"+Str(cyy)
If cyy
AddNode(5)
EndIf
ForEver
EndIf
; diagonal Up-Right
If sens<>7
x1=cx:y1=cy
Repeat
If is_wall(x1+1,y1) And is_wall(x1,y1-1):Break:EndIf
x1+1:y1-1
;Right
cxx=droite_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
If cxx
If cxx=ix:Break:EndIf
AddNode(6)
EndIf
;Up
cyy=gauche_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
If cyy
AddNode(6)
EndIf
ForEver
EndIf
;diagonal Down-Left
If sens<>6
x1=cx:y1=cy
Repeat
If (is_wall(x1-1,y1) And is_wall(x1,y1+1)):Break:EndIf
x1-1:y1+1
;Left
cxx=gauche_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
If cxx
If cxx=ix:Break:EndIf
AddNode(7)
EndIf
;Down
cyy=droite_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
If cyy
AddNode(7)
EndIf
ForEver
EndIf
;diagonal Up-Left
If sens<>5
x1=cx:y1=cy
Repeat
If is_wall(x1,y1-1) And is_wall(x1-1,y1):Break:EndIf
x1-1:y1-1
;Left
cxx=gauche_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
Debug Str(cxx)+"\"+Str(cyy)
If cxx
If cxx=ix:Break:EndIf
AddNode(8)
EndIf
;Up
cyy=gauche_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
Debug Str(cxx)+"\"+Str(cyy)
If cyy
AddNode(8)
EndIf
ForEver
EndIf
;}
*adr\open=2;close the current node
Wend
;no solution send back "0"
If cx<>Gx Or cy<>Gy
Heap_Free(*Heap_mem)
Hash_Free(*Hash_mem)
ProcedureReturn 0
EndIf
Heap_Free(*Heap_mem) ;free binary heap memory
;restitue la solution trouvée sous forme d'une liste
*parent.area11=Hash_Search(*Hash_mem,gx,gy);@area(gx,gy)
Repeat
x=*parent\x
y=*parent\y
InsertElement(*p\spot())
*p\spot()\x=x
*p\spot()\y=y
*parent=*parent\parent
Until *parent=0
prevx=Sx:prevy=Sy
ForEach *p\spot()
x=*p\spot()\x
y=*p\spot()\y
c=Abs(x-prevx)
d=Abs(y-prevy)
If x<>prevx And y<>prevy And c<>d
a=x-prevx
b=y-prevy
s=1
If Sign(a)<>Sign(b):s=-1:EndIf
If c<d
x=prevx+a
y=prevy+a*s
ElseIf d<c
x=prevx+b*s
y=prevy+b
EndIf
InsertElement(*p\spot())
*p\spot()\x=x
*p\spot()\y=y
EndIf
prevx=x:prevy=y
Next
Hash_Free(*Hash_mem)
;send back 1: path has been found
ProcedureReturn 1
EndProcedure
ProcedureDLL.l JPS_pathfind(sx.l,sy.l,gx.l,gy.l,*Area,*p.spt)
Debug "start "+Str(sx)+"/"+Str(sy)
Debug "goal "+Str(gx)+"/"+Str(gy)
ChangeCurrentElement(Area(),*Area)
largeur=Area()\largeur
*area_horizontal=area()\area_horizontal
*area_vertical=area()\area_vertical
ix=area()\ix
*Hash_mem=Hash_New(Int(ix/10),15,ix)
ClearList(*p\spot())
*Heap_mem=Heap_New()
; first node (start node) in open list
*a=Hash_Add(*Hash_mem,Sx,Sy,distance(Sx,Sy,gx,gy),0,sx,sy,1,#NUL,0,#NUL)
If *a=0:MessageRequester("debug","l'élement n'a pas pu être ajouté à la Hash_table "):EndIf
*Heap_mem=Heap_AddElement(*Heap_mem,*a);@Area(Sx,Sy))
If *Heap_mem=0:MessageRequester("debug","Un element n'a pas pu etre ajouté au tas"):EndIf
While Heap_Size(*Heap_mem)
;get the minimum f node
*adr.area11=Heap_GetMin(*Heap_mem)
Cx=*adr\x:Cy.l=*adr\y:Cg.l=*adr\g:sens=*adr\sens
If cx=Gx And cy=Gy:Break:EndIf
Debug "noeud examiné "+Str(cx)+"/"+Str(cy)
;{ RIGHT
If sens<>2
x1=cx+1:y1=cy
cxx=droite_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
;Debug Str(cxx)+"\"+Str(cyy)
If cxx And cxx<>ix
AddNode(1)
EndIf
EndIf
;LEFT
If sens<>1
x1=cx-1:y1=cy
cxx=gauche_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
;Debug Str(cxx)+"\"+Str(cyy)
If cxx And cxx<>ix
AddNode(2)
EndIf
EndIf
;down
If sens<>4
x1=cx:y1=cy+1
cyy=droite_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
;Debug Str(cxx)+"\"+Str(cyy)
If cyy And cyy<>ix
AddNode(3)
EndIf
EndIf
;UP
If sens<>3
x1=cx:y1=cy-1
cyy=gauche_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
;Debug Str(cxx)+"\"+Str(cyy)
If cyy And cyy<>ix
AddNode(4)
EndIf
EndIf
;diagonal down-right
If sens<>8
x1=cx:y1=cy
Repeat
If is_wall(x1+1,y1) And is_wall(x1,y1+1):Break:EndIf
x1+1:y1+1
;right
cxx=droite_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
;Debug Str(cxx)+"\"+Str(cyy)
If cxx
If cxx=ix:Break:EndIf
AddNode(5)
EndIf
;down
cyy=droite_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
;Debug Str(cxx)+"\"+Str(cyy)
If cyy
AddNode(5)
EndIf
ForEver
EndIf
; diagonal Up-Right
If sens<>7
x1=cx:y1=cy
Repeat
If is_wall(x1+1,y1) And is_wall(x1,y1-1):Break:EndIf
x1+1:y1-1
;Right
cxx=droite_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
If cxx
If cxx=ix:Break:EndIf
AddNode(6)
EndIf
;Up
cyy=gauche_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
If cyy
AddNode(6)
EndIf
ForEver
EndIf
;diagonal Down-Left
If sens<>6
x1=cx:y1=cy
Repeat
If (is_wall(x1-1,y1) And is_wall(x1,y1+1)):Break:EndIf
x1-1:y1+1
;Left
cxx=gauche_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
If cxx
If cxx=ix:Break:EndIf
AddNode(7)
EndIf
;Down
cyy=droite_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
If cyy
AddNode(7)
EndIf
ForEver
EndIf
;diagonal Up-Left
If sens<>5
x1=cx:y1=cy
Repeat
If is_wall(x1,y1-1) And is_wall(x1-1,y1):Break:EndIf
x1-1:y1-1
;Left
cxx=gauche_Fast(x1,y1,*area_horizontal,Gx,Gy):cyy=y1
;Debug Str(cxx)+"\"+Str(cyy)
If cxx
If cxx=ix:Break:EndIf
AddNode(8)
EndIf
;Up
cyy=gauche_Fast(y1,x1,*area_vertical,Gy,Gx):cxx=x1
;Debug Str(cxx)+"\"+Str(cyy)
If cyy
AddNode(8)
EndIf
ForEver
EndIf
;}
*adr\open=2;close the current node
Wend
;no solution send back "0"
If cx<>Gx Or cy<>Gy
Heap_Free(*Heap_mem)
Hash_Free(*Hash_mem)
ProcedureReturn 0
EndIf
Heap_Free(*Heap_mem) ;free binary heap memory
;restitue la solution trouvée sous forme d'une liste
*parent.area11=Hash_Search(*Hash_mem,gx,gy);@area(gx,gy)
Repeat
x=*parent\x
y=*parent\y
InsertElement(*p\spot())
*p\spot()\x=x
*p\spot()\y=y
*parent=*parent\parent
Until *parent=0
prevx=Sx:prevy=Sy
ForEach *p\spot()
x=*p\spot()\x
y=*p\spot()\y
c=Abs(x-prevx)
d=Abs(y-prevy)
If x<>prevx And y<>prevy And c<>d
a=x-prevx
b=y-prevy
s=1
If Sign(a)<>Sign(b):s=-1:EndIf
If c<d
x=prevx+a
y=prevy+a*s
ElseIf d<c
x=prevx+b*s
y=prevy+b
EndIf
InsertElement(*p\spot())
*p\spot()\x=x
*p\spot()\y=y
EndIf
prevx=x:prevy=y
Next
Debug " "
prevx=sx:prevy=sy
Debug sx
Debug sy
Debug ""
ForEach *p\spot()
x=*p\spot()\x
y=*p\spot()\y
If x=prevx And y<>prevy
a=Abs(y-prevy)
b=Sign(y-prevy)
PushListPosition(*p\spot())
For i=1 To a-1
InsertElement(*p\spot())
*p\spot()\x=x
*p\spot()\y=y-b
y=*p\spot()\y
Next i
PopListPosition(*p\spot())
ElseIf x<>prevx And y=prevy
a=Abs(x-prevx)
b=Sign(x-prevx)
PushListPosition(*p\spot())
For i=1 To a-1
InsertElement(*p\spot())
*p\spot()\x=x-b
*p\spot()\y=y
x=*p\spot()\x
Next i
PopListPosition(*p\spot())
ElseIf x<>prevx And y<>prevy
a=Abs(x-prevx)
b=Sign(x-prevx)
c=Abs(y-prevy)
d=Sign(y-prevy)
PushListPosition(*p\spot())
For i=1 To a-1
InsertElement(*p\spot())
*p\spot()\x=x-b
*p\spot()\y=y-d
x=*p\spot()\x
y=*p\spot()\y
Next i
PopListPosition(*p\spot())
EndIf
prevx=*p\spot()\x:prevy=*p\spot()\y
Next
Hash_Free(*Hash_mem)
;send back 1: path has been found
ProcedureReturn 1
EndProcedure
;regular A*
ProcedureDLL.l A_pathfind(Sx.l,Sy.l,Gx.l,Gy.l,*Area,*p.spt)
ChangeCurrentElement(Area(),*Area)
largeur=Area()\largeur
*area_horizontal=area()\area_horizontal
*area_vertical=area()\area_vertical
ix=area()\ix
*Hash_mem=Hash_New(Int(ix/10),15,ix)
*Heap_mem=Heap_New()
If *Heap_mem=0:MessageRequester("Error","Can't get a new heap"):EndIf
If *Hash_mem=0:MessageRequester("Error","Can't get a new hash Table"):EndIf
ClearList(*p\spot())
;*Hash_mem=
*H=Hash_Add(*Hash_mem,Sx,Sy,distance(Sx,Sy,Gx,Gy),0,Sx,Sy,0,#NUL,0,#NUL)
*Heap_mem=Heap_AddElement(*Heap_mem,*H)
While Heap_Size(*Heap_mem)
*adr.area11=Heap_GetMin(*Heap_mem)
Cx=*adr\x:Cy.l=*adr\y:Cg.l=*adr\g
If cx=Gx And cy=Gy:Break:EndIf
For j=-1 To 1
cyy=cy+j
For i=-1 To 1
If j=0 And i=0:Continue:EndIf
cxx=cx+i
If Is_Wall(Cxx,Cyy)=0
If j<>0 And i<>0
If Is_Wall(cx,cy+j)=0 Or Is_Wall(cx+i,cy)=0 ;empeche les diagonales entre deux blocs
A_AddNode
EndIf
Else
A_AddNode
EndIf
EndIf
Next i
Next j
*adr\open=2;close the current node
Wend
;soit il n'y a plus de noeud, soit on a trouvé le Goal
;no solution send back "0"
If cx<>Gx Or cy<>Gy
*Heap_mem=Heap_Clear(*Heap_mem)
Hash_Free(*Hash_mem)
heap_free(*Heap_mem)
ProcedureReturn 0
EndIf
If *p=0
*Heap_mem=Heap_Clear(*Heap_mem)
Hash_Free(*Hash_mem)
heap_free(*Heap_mem)
ProcedureReturn 1
EndIf
;restitue la solution trouvée sous forme d'une liste
If *p<>0
*parent.area11=Hash_Search(*Hash_mem,gx,gy);@area(gx,gy)
Repeat
x=*parent\x
y=*parent\y
InsertElement(*p\spot())
*p\spot()\x=x
*p\spot()\y=y
*parent=*parent\parent
Until *parent=0
EndIf
*Heap_mem=Heap_Clear(*Heap_mem)
heap_free(*Heap_mem)
Hash_Free(*Hash_mem)
ProcedureReturn 1
EndProcedure
Structure cache
f.l
g.l
*open
parentX.l
parentY.l
EndStructure
Structure Fringe
X.l
Y.l
EndStructure
ProcedureDLL.l FringeSearch_pathfind(Sx.l,Sy.l,Gx.l,Gy.l,*Area,*p.spt)
ChangeCurrentElement(Area(),*Area)
largeur=Area()\largeur
*area_horizontal=area()\area_horizontal
*area_vertical=area()\area_vertical
ix=area()\ix
ClearList(*p\spot())
NewList F.fringe()
*Hash_mem=Hash_New(Int(ix/10),15,ix)
If *Hash_mem=0:MessageRequester("Error","Can't get a new hash Table"):EndIf
*H.area11=Hash_Add(*Hash_mem,Sx,Sy,distance(Sx,Sy,Gx,Gy),0,Sx,Sy,AddElement(F()),0,0,#NUL)
F()\X=sx:F()\Y=sy
flimit=distance(Sx,Sy,Gx,Gy)
found=#False
While ListSize(F())
fmin.l=2147483646
ForEach F()
parent_x=F()\X:parent_y=F()\y
*H.area11=Hash_Search(*Hash_mem,parent_x,parent_y)
If *H\f>flimit
If fmin>*H\f
fmin=*H\f
EndIf
Continue
EndIf
If F()\x=Gx And F()\y=Gy:found=#True:Break 2:EndIf
parent_g=*H\g
*open=@F()
For j=-1 To 1
For i=-1 To 1
If j=0 And i=0:Continue:EndIf
Child_X=parent_x+i:Child_Y=parent_y+j
If Is_Wall(Child_X,Child_Y):Continue:EndIf
g_child=14
If i=0 Or j=0:g_child=10:EndIf
*H.area11=Hash_Search(*Hash_mem,Child_X,Child_Y)
If *H
If parent_g+g_child>=*H\g:Continue:EndIf
If *h\open
PushListPosition(F())
ChangeCurrentElement(F(),*h\open)
DeleteElement(F())
*h\open=0
PopListPosition(F())
EndIf
Hash_SearchDelete(*Hash_mem,Child_X,Child_Y)
EndIf
Hash_Add(*Hash_mem,Child_X,Child_Y,g_child+parent_g+distance(Child_X,Child_Y,Gx,Gy),g_child+parent_g,Child_X,Child_Y,AddElement(F()),parent_x,parent_y,#Null)
F()\X=Child_X:F()\Y=Child_Y
Next i
Next j
ChangeCurrentElement(F(),*open)
DeleteElement(F())
*h.area11=Hash_Search(*Hash_mem,Parent_X,Parent_Y)
*h\open=0
flimit=0
Next
flimit=fmin
Wend
If found=#True
x=Gx:y=Gy
*h.area11=Hash_Search(*Hash_mem,x,y)
While x<>sx Or y<>sy
InsertElement(*p\spot())
*p\spot()\x=x
*p\spot()\y=y
x=*h\sens
y=*h\parent
*h.area11=Hash_Search(*Hash_mem,x,y)
Wend
InsertElement(*p\spot())
*p\spot()\x=sx
*p\spot()\y=sy
hash_free(*Hash_mem)
ProcedureReturn 1
Else
hash_free(*Hash_mem)
ProcedureReturn 0
EndIf
EndProcedure
; OpenConsole("test")
; *Aa=CreateArea(128)
; Define p.spt
; FringeSearch_pathfind(10,10,15,17,*Aa,@p)
; ForEach p\spot()
; PrintN( Str(p\spot()\x)+"/"+Str(p\spot()\y))
; Next
; Repeat:ForEver
Code: Select all
;**************************************
;* Test Programm Pathfinding JUMP POINT STAR
;* [Right Clic] to add a Wall
;* [Left Clic] To delete a Wall
;*
;**************************************
Structure XY
x.l
y.l
EndStructure
Structure spt
List spot.XY()
EndStructure
Import "JPS_Astar.lib"
JPS_ONLY(sx.l,sy.l,gx.l,gy.l,*Area,*p.spt)
JPS_pathfind(sx.l,sy.l,gx.l,gy.l,*Area,*p.spt)
CreateArea(size.l)
AddWall(x.l,y.l,*Area)
IsWall(x.l,y.l,*Area)
DeleteWall(x.l,y.l,*Area)
DeleteArea(*Area)
A_pathfind(Sx.l,Sy.l,Gx.l,Gy.l,*Area,*p.spt)
FringeSearch_pathfind(Sx.l,Sy.l,Gx.l,Gy.l,*Area,*p.spt)
EndImport
Enumeration
#JPSALLNODE
#ASTAR
#FRINGE
EndEnumeration
Global p.spt,Goal.XY,Start.XY
;area width is a square. (have to be a power of 2 !!!!! ie: 16, 32, 64, 128, 256, 512, 1024, 2048 ...etc)
;you can reduce it by adding walls if you need a smaller area.
#Lx=1024
;tile width to display
#Lt=1
Global *Area=CreateArea(#Lx)
Global iLt=#Lt:If #Lt<3:iLt=3:EndIf
Dim message$(3)
message$(0)="Jump Point Search"+Chr(13)+" Pro: really fast, small memory print"+Chr(13)+" Con: Can't use an attraction map"+Chr(13)+Chr(13)+"Online Algo"
message$(1)="A Star"+Chr(13)+" Pro: Attraction map possible"+Chr(13)+" Con: Slow on big map O(n*log(n))"+Chr(13)+Chr(13)+"Online Algo"
message$(2)="Fringe Search"+Chr(13)+" Pro: No sorting needed"+Chr(13)+" Con: very Slow on big map: O(n²)"+Chr(13)+Chr(13)+"Online Algo"
message$(3)="NO PATH EXISTS ! SORRY..."
Procedure.q Pathfind(Path.i)
timer.q=ElapsedMilliseconds()
Select path
Case #JPSALLNODE
result=JPS_pathfind(start\x,start\y,goal\x,goal\y,*Area,@p)
Case #ASTAR
result=A_pathfind(start\x,start\y,goal\x,goal\y,*Area,@p)
Case #FRINGE
result=FringeSearch_pathfind(start\x,start\y,goal\x,goal\y,*Area,@p)
EndSelect
timer=ElapsedMilliseconds()-timer
If result=0:timer=-timer:If timer=0:timer=-1:EndIf:EndIf
StartDrawing(ImageOutput(0))
Box(0,0,#lx,#lx,#Black)
For j=0 To #Lx-1
For i=0 To #Lx-1
If IsWall(i,j,*Area):Box(i*#Lt,j*#Lt,#Lt,#Lt,#Blue):EndIf
Next i
Next j
oldx=start\x*#Lt:oldy=start\y*#Lt
ForEach p\spot()
LineXY(p\spot()\x*#Lt,p\spot()\y*#Lt,oldx,oldy,#Green)
Box(p\spot()\x*#Lt,p\spot()\y*#Lt,iLt,iLt,#Green)
oldx=p\spot()\x*#Lt:oldy=p\spot()\y*#Lt
Next
Box(start\x*#Lt,start\y*#Lt,iLt,iLt,#Red):Box(goal\x*#Lt,goal\y*#Lt,iLt,iLt,#Red)
StopDrawing()
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(0),0,0)
StopDrawing()
ProcedureReturn timer
EndProcedure
Procedure Add_Delete_Wall(Add_Delete.i)
x = GetGadgetAttribute(0, #PB_Canvas_MouseX)
y = GetGadgetAttribute(0, #PB_Canvas_MouseY)
x=Int(x/#Lt):y=Int(y/#Lt)
If Add_Delete
AddWall(x,y,*Area)
color=#Blue
Else
DeleteWall(x,y,*Area)
color=#Black
EndIf
StartDrawing(ImageOutput(0))
Box(x*#Lt,y*#Lt,#Lt,#Lt,color)
StopDrawing()
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(0),0,0)
StopDrawing()
EndProcedure
Procedure Random_Start_And_Goal()
Repeat
start\x=Random(#Lx-2)+1
start\y=Random(#Lx-2)+1
Until IsWall(start\x,start\y,*Area)=0
Repeat
goal\x=Random(#Lx-2)+1
goal\y=Random(#Lx-2)+1
Until IsWall(goal\x,goal\y,*Area)=0
EndProcedure
Procedure Generate_Maze()
size=GetGadgetState(7)
Dim air.i(#Lx,#Lx)
Dim dir.xy(3)
NewList stack.xy()
dir(0)\x=0:dir(0)\y=-1:dir(1)\x=1:dir(1)\y=0
dir(2)\x=0:dir(2)\y=1:dir(3)\x=-1:dir(3)\y=0
;rempli la carte
For j=0 To #Lx-1
For i=0 To #Lx-1
If i=0 Or j=0 Or i>(#Lx-size-1) Or j>(#Lx-size-1)
air(i,j)=1
AddWall(i,j,*area)
Else
deleteWall(i,j,*area)
EndIf
Next i
Next j
x=size:y=size ;start coords
Repeat
While air(x,y-size) And air(x-size,y) And air(x+size,y) And air(x,y+size)
;maze completed
If ListSize(stack())=0:Break 2:EndIf
;regression in stack
x=stack()\x:y=stack()\y
DeleteElement(stack())
Continue
Wend
;choose a direction
Repeat
dir=Random(3)
xx=x+size*dir(dir)\x
yy=y+size*dir(dir)\y
Until air(xx,yy)=0
air(xx,yy)=1
AddElement(stack())
stack()\x=x:stack()\y=y
For j=0 To size-1
For i=0 To size-1
addWall(x+dir(dir)\x*i,y+dir(dir)\y*j,*area)
Next i
Next j
x=xx:y=yy
ForEver
StartDrawing(ImageOutput(0))
Box(0,0,#lx,#lx,#Black)
For j=0 To #Lx-1
For i=0 To #Lx-1
If IsWall(i,j,*Area):Box(i*#Lt,j*#Lt,#Lt,#Lt,#Blue):EndIf
Next i
Next j
StopDrawing()
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(0),0,0)
StopDrawing()
EndProcedure
Procedure Clean_Area()
;rempli la carte de murs
For j=0 To #Lx-1
For i=0 To #Lx-1
If i=0 Or j=0 Or i=(#Lx-1) Or j=(#Lx-1)
AddWall(i,j,*area)
Else
deleteWall(i,j,*area)
EndIf
Next i
Next j
StartDrawing(ImageOutput(0))
Box(0,0,#lx*#Lt,#lx*#Lt,#Black)
For j=0 To #Lx-1
For i=0 To #Lx-1
If IsWall(i,j,*Area):Box(i*#Lt,j*#Lt,#Lt,#Lt,#Blue):EndIf
Next i
Next j
StopDrawing()
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(0),0,0)
StopDrawing()
EndProcedure
If OpenWindow(0, 0, 0, #Lx*#Lt+200, #Lx*#Lt, "Pathfindings", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0:MessageRequester("Error", "Problem To create windows"):EndIf
y=10
ButtonGadget(6,10,y, 100, 25, "Generate Maze")
SpinGadget(7,120, y, 40, 25, 2, 32,#PB_Spin_Numeric)
SetGadgetText(7, "10")
y+40
ButtonGadget(8,10,y, 100, 25, "Clean Zone")
y+40
ComboBoxGadget(1,10,y,170,#lx)
AddGadgetItem(1,-1,"Jump Point Star")
AddGadgetItem(1,-1,"A Star")
AddGadgetItem(1,-1,"Fringe Search")
SetGadgetState(1, 0)
y+40
ButtonGadget(4,10,y, 100, 25, "Random Points")
y+40
ButtonGadget(2,10,y, 100, 25, "Start Pathfinding")
y+40
TextGadget(3,10,y,180,300,"")
CanvasGadget(0,200,0, #Lx*#Lt, #Lx*#Lt)
CreateImage(0,#Lx*#Lt,#Lx*#Lt)
Clean_Area()
Random_Start_And_Goal()
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
event= EventGadget()
If Event = 0
;left clic
If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(0, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
Add_Delete_Wall(1)
;right clic
ElseIf EventType() = #PB_EventType_RightButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(0, #PB_Canvas_Buttons) & #PB_Canvas_RightButton)
Add_Delete_Wall(0)
EndIf
ElseIf event=2 Or event=4
If event=4:Random_Start_And_Goal():EndIf
pathfinding=GetGadgetState(1)
mess$=GetGadgetText(1)
timer.q=Pathfind(pathfinding)
If timer<0:pathfinding=3:timer=-timer:EndIf
mess$="Area contains "+#Lx+"x"+#Lx+" cells"+Chr(13)+Chr(13)+mess$+" took "+Str(timer)+" ms To complete"+Chr(13)+Chr(13)+message$(pathfinding)
SetGadgetText(3,mess$)
ElseIf event=6
Generate_Maze()
ElseIf event=8
Clean_Area()
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
Code: Select all
Structure XY
x.l
y.l
EndStructure
Structure spt
List spot.XY()
EndStructure
Define p.spt
Import "JPS_Astar.lib"
CreateArea(size.l) ;=>create a square area size (power of 2, ie 64, 128, 256, 512 etc...) large
;If your map is 100x80, CreateArea(128) will be use and just add walls at lines 100 and 80 to make the area smaller.
AddWall(x.l,y.l) ;=>add a non traversable node
DeleteWall(x.l,y.l) ;=>make a node traversable
IsWall(x.l,y.l) ;=> Test obstacle presence (return 0/1)
JPS_pathfind(sx.l,sy.l,gx.l,gy.l,*p.spt) ;=> process JPS pathfinding from Point(sx,sy) to point(gx,gy). list of points in p\spot()\x,y (return 0 if no path exists)
A_pathfind(sx.l,sy.l,gx.l,gy.l,*p.spt) ;=> process regular A* pathfinding from Point(sx,sy) to point(gx,gy). list of points in p\spot()\x,y (return 0 if no path exists)
EndImport