Jump Point Search (Pathfinding)

Advanced game related topics
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Jump Point Search (Pathfinding)

Post by Fig »

[LAST UPDATE 11/11/18]
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)

Image

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
DLL named "Heap"

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
DLL named "JPS_Astar"

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
Test program

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
If you want to include it in your game, this is the minimum needed:

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
Last edited by Fig on Mon Nov 12, 2018 9:35 pm, edited 45 times in total.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: Jump Point Search (Pathfinding)

Post by Fig »

23/03/17 MAJ labyrinthe for tests and add Classical A* algo to compare speed.
26/03/17 JPS improved: no need to test the parent's node direction.(1/8th faster now)
30/07/18 modified test program (cleaner), post DLL codes, add mazes' generator and gui. Add warning messages in Dll.
04/08/18 Add Clean button to the test program.
07/08/18 Add Fringe Search algo, but it's way slower than A* dispite what the paper said.
11/11/18 Corrected a memory bug.
Last edited by Fig on Sun Nov 11, 2018 6:51 pm, edited 7 times in total.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: Jump Point Search (Pathfinding)

Post by djes »

Thank you for this great piece of code :D
zefiro_flashparty
User
User
Posts: 74
Joined: Fri Mar 04, 2005 7:46 pm
Location: argentina

Re: Jump Point Search (Pathfinding)

Post by zefiro_flashparty »

ohh :D :D That's good, I'll take a look. I made one of my own, with the classic theory, but I use it in a city simulator, and end up doing strange things the cars and the people...
:? :oops:
Amd Vishera fx8350 ,16Gbram, Gtx650 ti, 2gb,Win 10pro. 13tbs. 8)
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: Jump Point Search (Pathfinding)

Post by Fig »

Pretty easy to test in your game, see the minimum required in first post. :wink:
Last edited by Fig on Sat Aug 04, 2018 3:34 pm, edited 5 times in total.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
pbfast
New User
New User
Posts: 6
Joined: Wed Aug 23, 2017 11:16 am

Re: Jump Point Search (Pathfinding)

Post by pbfast »

Thanks JPS is really fast
Is it stable to be used for our games? Can you give a quick hint on how to avoid it from clinging/hugging wall to make it more natural?
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: Jump Point Search (Pathfinding)

Post by Fig »

As far as i know, it's stable on my computer, but i actually didn't test it on several configurations.
The asm parts are kind of tricky... Who knows ?

JPS doesn't use elaborate attractive/repulsive map.
In that case, you'll need to use a standard A* implementation which is slower but more flexible for different purposes. (not only pathfinding)
Notice, the path follows walls only if it turns later in that direction. if area are wide opens, it goes straight through.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
pbfast
New User
New User
Posts: 6
Joined: Wed Aug 23, 2017 11:16 am

Re: Jump Point Search (Pathfinding)

Post by pbfast »

By the way I used directly the code and not the compiled dll.
I'm trying to update the wall data on real-time and check if route is possible but encounter same error.
It works if I don't update the wall data.

Here's how i did.
CreateArea(512) ; init area

;update/change all wall data in real-time captured from camera
while quit = #false
for y = 0 to 399
for x = 0 to 399
if screenblock(x,y) = #black
addwall(x,y)
else
deletewall(x,y)
endif

; check if path is possible on given point
if JPS_Fast(50,50,60,60,@s.spt)
debug "found path"
quit = #true
endif
next
next
wend

I always get this error from this part.
Procedure.l gauche_Fast(x.l,y.l,*area_1,Gx.l,Gy.l)
EnableASM
MOV ebx,dword [p.v_x]
MOV eax,dword [p.v_y]
DEC eax ;passe à la ligne Above
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 result, 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:
;Above 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 Above
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
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: Jump Point Search (Pathfinding)

Post by Fig »

You can't/shouldn't delete a wall on the 0 and 511 row/column.
The area has to be surrounded by a wall all the time.(it saves boundaries tests) So you can only use 1->510 cells.

Maybe it's the problem here as you update the x=0 and y=0 (?)

Also,for performance purpose, i suggest you record walls that change and update that specifics cells, not all of them.
But It shouldn't be an issue.

Thank you for testing. :D
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
Joubarbe
Enthusiast
Enthusiast
Posts: 555
Joined: Wed Sep 18, 2013 11:54 am
Location: France

Re: Jump Point Search (Pathfinding)

Post by Joubarbe »

Would it be possible to have a valid link for this? Thanks.
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: Jump Point Search (Pathfinding)

Post by djes »

Joubarbe wrote:Would it be possible to have a valid link for this? Thanks.
This one is still valid
http://dl.free.fr/kEjXIisxg
Click on «télécharger ce fichier» button
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: Jump Point Search (Pathfinding)

Post by Fig »

Thank you Djes.

I warn again, when you create a 512 area, for instance, it creates a 512x512 map of cells. The first and last rows and columns are filled with walls. (ie 0 coords and 511 coords).
DO NOT DELETE OR REWRITE THESE WALLS !! It would crash the program.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Re: Jump Point Search (Pathfinding)

Post by Mistrel »

Does anyone still have a copy of this?

Thank you.
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Jump Point Search (Pathfinding)

Post by RSBasic »

Yes: https://www.rsbasic.de/backups/ :arrow: JumpPointStar.zip :)
Image
Image
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Re: Jump Point Search (Pathfinding)

Post by Mistrel »

Thank you! :)
Post Reply