Dynamic A* Pathfinding 3.2

[Fig]

Optimisation on large map, i suggest HPA*... (hierarchical pathfinding)
I also suggest to use a hashmap instead of dim to decrease memory impact.

[luis]

Another defaced thread ? What is with this spreading mania of editing a thread up to the point to make it useless ?
I had this bookmarked as "Dynamic A* Pathfinding 3.2", now it's just this: "........"
And now we have just meaningless comments about something that's not there anymore.

... leaves shaking his head ...

[IdeasVacuum]

I agree luis - this is the 3rd post I have seen that has been butchered in this way. Why do it? If the code is 'old' or flawed in some way, a simple note to that effect would be better.

[Demivec]

I had this bookmarked as "Dynamic A* Pathfinding 3.2", now it's just this: "........"
And now we have just meaningless comments about something that's not there anymore.

Here's the code for v3.1 which is need of some corrections (according to the thread here), it is dated Sep 10, 2007.

Code: Select all

;Written by Heathen
Structure pathfinding_structure ;Main Options
  Width.l ; Width of the grid (cells, not pixels)
  Height.l ; Height of the grid (cells, not pixels)
  tilesize.w ;Size of the cells (tiles) in pixels. For now, this applies to everything.
  allowdiag.c ;Can move diagonally?
  blockdiag.c ;Can move diagonally between blocked squares?
  blocked.l ;pointer to a 2d array (width-1,height-1). 1 = blocked, 0 = free
  Priority.l ;pointer to a 2d array (width-1,height-1). 0-100. 0 = normal/low priority, 100 = high priority
  cast_ray.c ;try to cast a ray before pathfinding? Please use with caution as this needs more work
  dynamic.l ;pointer to a 1d array of structure pointers (which contain x and y coordinates). This is for dynamic pathfinding and is optional.
  dynamic_size.w ;size of the array structure. (Can use sizeof(structure))
  xoff.w ;offset in the structure of the x coordinate (in pixels). (Can use offsetof(structure/x))
  yoff.w ;offset in the structure of the y coordinate (in pixels). (Can use offsetof(structure/y)))
  xto_off.w ;offset to the next x coordinate (in cells). -The square the object will move to next-. (not necessary but can lead to less problems and will usuall be faster/more precise.)
  yto_off.w ;offset to the next y coordinate (in cells). -The square the object will move to next-. (not necessary but can lead to less problems and will usually be faster/more precise.)
  dynamic_count.w ;number of items in the array. (Doesn't have to be the size of the whole array, just the size you are using)
  ignore.l ;Dynamic array index to ignore.  Can use 'ignore_ovverride' arguments in the procedures to override this with a new index.
  cost.w ;cost to move horizontally and vertically (optional default 10)
  diagcost.w ;cost to move diagonally (option default 14)
  alt_copymemory.c
EndStructure


;{ Internal
Structure openlist
  x.l
  y.l
  f.l
EndStructure
strucsize_.c  = SizeOf(openlist)

Procedure CopyMemoryAMD(*src, *dst, Size) ;El_Choni wrote this procedure, thanks El_Choni! (made some small changes)
  !MOV Esi, [p.p_src] ; source array
  !MOV Edi, [p.p_dst] ; destination array
  !MOV Ecx, [p.v_Size]
  !MOV  Ebx, Ecx
  !CLD
  !CMP  Ecx, 60
  !JB  l_memcpy_ic_3
  !CMP  Ecx, 32*1024 
  !JBE  l_memcpy_do_align
  !CMP  Ecx, 64*1024
  !JBE  l_memcpy_align_done
  memcpy_do_align:
  !MOV  Ecx, 8 
  !SUB  Ecx, Edi
  !AND  Ecx, 7
  !SUB  Ebx, Ecx 
  !NEG  Ecx   
  !ADD  Ecx, l_memcpy_align_done
  !JMP  Ecx
  !ALIGN 4
  !movsb
  !movsb
  !movsb
  !movsb
  !movsb
  !movsb
  !movsb
  !movsb
  memcpy_align_done:
  !MOV  Ecx, Ebx
  !SHR  Ecx, 6 
  !JZ  l_memcpy_ic_2
  !CMP  Ecx, (64*1024)/64
  !JAE  l_memcpy_uc_test
  ;!ALIGN 16
  memcpy_ic_1:   
  !prefetchnta [Esi+(200*64/34+192)] 
  !movq mm0, [Esi+0]
  !movq mm1, [Esi+8]
  !movq [Edi+0], mm0
  !movq [Edi+8], mm1
  !movq mm2, [Esi+16]
  !movq mm3, [Esi+24]
  !movq [Edi+16], mm2
  !movq [Edi+24], mm3
  !movq mm0, [Esi+32]
  !movq mm1, [Esi+40]
  !movq [Edi+32], mm0
  !movq [Edi+40], mm1
  !movq mm2, [Esi+48]
  !movq mm3, [Esi+56]
  !movq [Edi+48], mm2
  !movq [Edi+56], mm3
  !ADD  Esi, 64 
  !ADD  Edi, 64 
  !DEC  Ecx 
  !JNZ  l_memcpy_ic_1
  memcpy_ic_2:
  !MOV  Ecx, Ebx
  memcpy_ic_3:
  !SHR  Ecx, 2
  !AND  Ecx, 15
  !NEG  Ecx 
  !ADD  Ecx, l_memcpy_last_few
  !JMP  Ecx 
  memcpy_uc_test:
  !CMP  Ecx, $80/2
  !JAE  l_memcpy_bp_1
  memcpy_64_test:
  !OR  Ecx, Ecx
  !JZ  l_memcpy_ic_2
  memcpy_uc_1:   
  !prefetchnta [Esi+(200*64/34+192)] 
  !movq mm0, [Esi+0]
  !ADD  Edi, 64 
  !movq mm1, [Esi+8]
  !ADD  Esi, 64 
  !movq mm2, [Esi-48]
  !movntq [Edi-64], mm0
  !movq mm0, [Esi-40]
  !movntq [Edi-56], mm1
  !movq mm1, [Esi-32]
  !movntq [Edi-48], mm2
  !movq mm2, [Esi-24]
  !movntq [Edi-40], mm0
  !movq mm0, [Esi-16]
  !movntq [Edi-32], mm1
  !movq mm1, [Esi-8]
  !movntq [Edi-24], mm2
  !movntq [Edi-16], mm0
  !DEC  Ecx
  !movntq [Edi-8], mm1
  !JNZ  l_memcpy_uc_1
  !JMP  l_memcpy_ic_2 
  memcpy_bp_1:   
  !CMP  Ecx, $80
  !JL  l_memcpy_64_test 
  !MOV  Eax, $80/2
  !ADD  Esi, $80*64
  ;!ALIGN 16
  memcpy_bp_2:
  !MOV  Edx, [Esi-64] 
  !MOV  Edx, [Esi-128] 
  !SUB  Esi, 128   
  !DEC  Eax     
  !JNZ  l_memcpy_bp_2
  !MOV  Eax, $80
  ;!ALIGN 16
  memcpy_bp_3:
  !movq mm0, [Esi]
  !movq mm1, [Esi+ 8]
  !movq mm2, [Esi+16]
  !movq mm3, [Esi+24]
  !movq mm4, [Esi+32]
  !movq mm5, [Esi+40]
  !movq mm6, [Esi+48]
  !movq mm7, [Esi+56]
  !ADD  Esi, 64   
  !movntq [Edi], mm0 
  !movntq [Edi+ 8], mm1
  !movntq [Edi+16], mm2
  !movntq [Edi+24], mm3 
  !movntq [Edi+32], mm4 
  !movntq [Edi+40], mm5
  !movntq [Edi+48], mm6
  !movntq [Edi+56], mm7
  !ADD  Edi, 64   
  !DEC  Eax   
  !JNZ  l_memcpy_bp_3 
  !SUB  Ecx, $80
  !JMP  l_memcpy_bp_1 
  !ALIGN 4
  !movsd
  !movsd   
  !movsd
  !movsd
  !movsd
  !movsd
  !movsd
  !movsd
  !movsd
  !movsd 
  !movsd
  !movsd
  !movsd
  !movsd
  !movsd
  !movsd
  memcpy_last_few: 
  !MOV  Ecx, Ebx
  !AND  Ecx, 3
  !JZ  l_memcpy_final
  !REP  movsb 
  memcpy_final:
  !emms   
  !sfence
EndProcedure
Macro check(xx,yy,gg=cost)
  If xx > -1 And yy > -1 And xx < Width And yy < Height And open(xx,yy) > -1
    g = gg+g(x,y)
    p = array_2d(Priority,Width,xx,yy)
    If p > 0
      g/(100/p)
    EndIf
    If (open(xx,yy) = 0 Or g < g(xx,yy))
      xd = xend-xx
      yd = yend-yy
      If xd < 0 : xd = -xd : EndIf
      If yd < 0 : yd = -yd : EndIf
      g(xx,yy) = g
      parentx(xx,yy) = x
      parenty(xx,yy) = y
      If open(xx,yy) > 0
        openlist(open(xx,yy))\f = xd+yd + g(xx,yy)
        pos = open(xx,yy)
      Else
        oc + 1
        If oc/50 >= oa
          oa+1
          ReDim openlist.openlist(oa*50)
        EndIf
        openlist(oc)\x = xx
        openlist(oc)\y = yy
        openlist(oc)\f = xd+yd + g(xx,yy)
        open(xx,yy) = oc
        pos = oc
      EndIf
      a = pos >> 1
      While pos > 1 And openlist(pos)\f < openlist(a)\f
        open(openlist(pos)\x,openlist(pos)\y) = a
        open(openlist(a)\x,openlist(a)\y) = pos
        If Not alt_copymemory
          CopyMemory(@openlist(pos),*temp,strucsize_)
          CopyMemory(@openlist(a),@openlist(pos),strucsize_)
          CopyMemory(*temp,@openlist(a),strucsize_)
        Else
          CopyMemoryAMD(@openlist(pos),*temp,strucsize_)
          CopyMemoryAMD(@openlist(a),@openlist(pos),strucsize_)
          CopyMemoryAMD(*temp,@openlist(a),strucsize_)
        EndIf
        pos = a
        a = pos >> 1
      Wend
    EndIf
  EndIf
EndMacro
Procedure.c array_2d(pointer,Width,field1,field2,pointer2=0)
  If pointer > 0
    Protected c = PeekC(pointer+field1*Width+field2)
    If c = 0 And pointer2 > 0
      c = PeekC(pointer2+field1*Width+field2)
    EndIf
    ProcedureReturn c
  EndIf
  ProcedureReturn 0
EndProcedure
Procedure ray(x,y,xto,yto,blocked,Width,diag,dyn=0)
  Protected xd,yd,a.w,b.w,d
  *mem = AllocateMemory(8)
  b = 0
  Repeat
    If array_2d(blocked,Width,x,y,dyn) = 1
      FreeMemory(*mem)
      ProcedureReturn 0
    Else
      PokeL(*mem+b*8,x)
      PokeL(*mem+b*8+4,y)
      b + 1
      xd = xto-x
      yd = yto-y
      If xd < 0 : xd = -xd : EndIf
      If yd < 0 : yd = -yd : EndIf
      d = xd+yd
      *mem = ReAllocateMemory(*mem,(b+1)*8)
    EndIf
    a = 0
    If xto > x : x + 1 : a = 1
    ElseIf xto < x : x - 1 : a = 1
    EndIf
    If a = 0 Or diag = 1
      If yto > y : y + 1
      ElseIf yto < y : y - 1
      EndIf
    EndIf
    If x = xto And y = yto
      ReAllocateMemory(*mem,b*8)
      ProcedureReturn *mem
    EndIf
  ForEver
EndProcedure
Macro get_ops()
  Width.l = *pathfinding_structure\Width
  Height.l = *pathfinding_structure\Height
  allowdiag.c = *pathfinding_structure\allowdiag
  blockdiag.c = *pathfinding_structure\blockdiag
  blocked.l = *pathfinding_structure\blocked
  Priority.l = *pathfinding_structure\Priority
  cast_ray.l = *pathfinding_structure\cast_ray
  dynamic.l  = *pathfinding_structure\dynamic
  dynamic_size.w = *pathfinding_structure\dynamic_size
  xoff.w = *pathfinding_structure\xoff
  yoff.w = *pathfinding_structure\yoff
  xto_off.w = *pathfinding_structure\xto_off
  yto_off.w = *pathfinding_structure\yto_off
  dynamic_count.w = *pathfinding_structure\dynamic_count
  ignore.l = *pathfinding_structure\ignore
  tilesize.w = *pathfinding_structure\tilesize
  cost.w = *pathfinding_structure\cost
  diagcost.w = *pathfinding_structure\diagcost
  alt_copymemory.c = *pathfinding_structure\alt_copymemory
  If cost = 0
    cost = 10
  EndIf
  If diagcost = 0
    diagcost = 14
  EndIf
  If ignore_override > 0
    ignore = ignore_override
  EndIf
EndMacro
;}

Procedure.l get_path(xstart,ystart,xend,yend,*pathfinding_structure.pathfinding_structure,ignore_override.l=0)
  get_ops()
  If (xstart = xend And yend = ystart) Or Width < 1 Or Height < 1
    ProcedureReturn 0
  EndIf
  Protected x,y,g,xx,yy,xd,yd,oc,pos,a,oa.w=1,b1.c,b2.c,b3.c,b4.c,d.c=0
  If dynamic > 0 And dynamic_size > 0 And dynamic_count > 0
    Dim dynamic.c(Width-1,Height-1)
    Protected dyn = @dynamic()
    For x = 0 To dynamic_count-1
      If x <> ignore
        xx = PeekL(dynamic+x*dynamic_size+xoff)/tilesize
        yy = PeekL(dynamic+x*dynamic_size+yoff)/tilesize
        dynamic(xx,yy) = 1
        If xto_off > 0 And yto_off > 0 And dynamic(xx,yy) = 0
          xx = PeekL(dynamic+x*dynamic_size+xto_off)
          yy = PeekL(dynamic+x*dynamic_size+yto_off)
          dynamic(xx,yy) = 1
        EndIf
      EndIf
    Next x
  EndIf
  If cast_ray = 1
    Protected r
    r = ray(xend,yend,xstart,ystart,blocked,Width,allowdiag,dyn)
    If r > 0
      Debug "ray"
      ProcedureReturn r
    EndIf
  EndIf
  Shared strucsize_
  Protected Dim openlist.openlist(50)
  Protected Dim g.l(Width-1,Height-1)
  Protected Dim open.l(Width-1,Height-1)
  Protected Dim parentx.l(Width-1,Height-1)
  Protected Dim parenty.l(Width-1,Height-1)
  Protected *temp = AllocateMemory(strucsize_)
  x = xstart : y = ystart : open(x,y) = -1
  Repeat
    If x-1 >=0 : b1 = array_2d(blocked,Width,x-1,y,dyn) : Else :  b1=0 : EndIf
    If x+1 < Width : b2 = array_2d(blocked,Width,x+1,y,dyn) : Else : b2=0 : EndIf
    If y-1 >= 0 : b3 = array_2d(blocked,Width,x,y-1,dyn) : Else :  b3=0 : EndIf
    If y+1 < Height : b4 = array_2d(blocked,Width,x,y+1,dyn) : Else :  b4=0 : EndIf
    If allowdiag
      If array_2d(blocked,Width,x+1,y-1,dyn)=0 And (blockdiag = 0 Or (blockdiag=1 And (b2 = 0 Or b3=0)))
        check(x+1,y-1,diagcost)
      EndIf
      If array_2d(blocked,Width,x-1,y+1,dyn)=0 And (blockdiag = 0 Or (blockdiag=1 And (b1= 0 Or b4=0)))
        check(x-1,y+1,diagcost)
      EndIf
      If array_2d(blocked,Width,x-1,y-1,dyn)=0 And (blockdiag = 0 Or (blockdiag=1 And (b1 = 0 Or  b3=0)))
        check(x-1,y-1,diagcost)
      EndIf
      If array_2d(blocked,Width,x+1,y+1,dyn)=0 And (blockdiag = 0 Or (blockdiag=1 And (b2 = 0 Or b4=0)))
        check(x+1,y+1,diagcost)
      EndIf
    EndIf
    If b1 = 0 : check(x-1,y) : EndIf
    If b2 = 0 : check(x+1,y) : EndIf
    If b3 = 0 : check(x,y-1) : EndIf
    If b4 = 0 : check(x,y+1) : EndIf
    If oc = 0
      FreeMemory(*temp)
      ProcedureReturn 0
    EndIf
    x = openlist(1)\x
    y = openlist(1)\y
    open(x,y) = -1
    open(openlist(oc)\x,openlist(oc)\y) = 1
    If Not alt_copymemory
      CopyMemory(@openlist(oc),@openlist(1),strucsize_)
    Else
      CopyMemoryAMD(@openlist(oc),@openlist(1),strucsize_)
    EndIf
    oc-1
    If oc > 1
      pos = 1
      Repeat
        a = pos << 1
        c = 0
        If a <= oc And openlist(pos)\f >= openlist(a)\f
          c = 1
        EndIf
        If a+1 <= oc And openlist(pos)\f >= openlist(a+1)\f And (c = 0 Or (c = 1 And openlist(a+1)\f < openlist(a)\f))
          a + 1
          c = 1
        EndIf
        If c = 1
          open(openlist(pos)\x,openlist(pos)\y) = a
          open(openlist(a)\x,openlist(a)\y) = pos
          If Not alt_copymemory
            CopyMemory(@openlist(pos),*temp,strucsize_)
            CopyMemory(@openlist(a),@openlist(pos),strucsize_)
            CopyMemory(*temp,@openlist(a),strucsize_)
          Else
            CopyMemoryAMD(@openlist(pos),*temp,strucsize_)
            CopyMemoryAMD(@openlist(a),@openlist(pos),strucsize_)
            CopyMemoryAMD(*temp,@openlist(a),strucsize_)
          EndIf
          pos=a
        Else
          Break 1
        EndIf
      ForEver
    EndIf
  Until x = xend And y = yend
  pos = 0
  *mem = AllocateMemory(320)
  oa = 0
  Repeat
    PokeL(*mem+pos,x)
    PokeL(*mem+pos+4,y)
    xx = parentx(x,y)
    yy = parenty(x,y)
    x = xx
    y = yy
    pos + 8
    If (x <> xstart Or y <> ystart) And pos/320 > oa
      oa + 1
      *mem = ReAllocateMemory(*mem,(oa+1)*320)
    EndIf
  Until x = xstart And y = ystart
  ReAllocateMemory(*mem,pos)
  FreeMemory(*temp)
  ProcedureReturn *mem
EndProcedure
Procedure path_get_size(*path)
  If *path > 0
    ProcedureReturn MemorySize(*path)/8
  Else
    ProcedureReturn -1
  EndIf
EndProcedure
Procedure path_get_x(*path,ind)
  If *path > 0
    Protected s = MemorySize(*path)
    ind + 1
    If ((s-(ind*8))+4<=s Or ind = 0) And s > 0
      ProcedureReturn PeekW(*path+(s-(ind*8)))
    EndIf
  EndIf
  ProcedureReturn -1
EndProcedure
Procedure path_get_y(*path,ind)
  If *path > 0
    Protected s = MemorySize(*path)
    ind + 1
    If ((s-(ind*8))+8<=s Or ind = 0) And s > 0
      ProcedureReturn PeekW((*path+(s-(ind*8)))+4)
    EndIf
  EndIf
  ProcedureReturn -1
EndProcedure

;{ The following procedures are optional 'utility' procedures.

Procedure is_node_at(*path,x,y)
  If *path > 0
    s = path_get_size(*path)
    If s > 0
      For I = 0 To s-1
        If path_get_x(*path,I) = x And path_get_y(*path,I) = y
          ProcedureReturn 1
        EndIf
      Next I
    EndIf
  EndIf
  ProcedureReturn 0
EndProcedure
Procedure validate_path(*path,*pathfinding_structure.pathfinding_structure,ignore_override=0)
  If *path > 0
    get_ops()
    s = path_get_size(*path)
    If s > 0
      Protected dyn
      If dynamic > 0 And dynamic_size > 0 And dynamic_count > 0
        Dim dynamic.c(Width-1,Height-1)
        dyn = @dynamic()
        For x = 0 To dynamic_count-1
          If x <> ignore
            xx = PeekL(dynamic+x*dynamic_size+xoff)/tilesize
            yy = PeekL(dynamic+x*dynamic_size+yoff)/tilesize
            dynamic(xx,yy) = 1
            If xto_off > 0 And yto_off > 0 And dynamic(xx,yy) = 0
              xx = PeekL(dynamic+x*dynamic_size+xto_off)
              yy = PeekL(dynamic+x*dynamic_size+yto_off)
              dynamic(xx,yy) = 1
            EndIf
          EndIf
        Next x
      EndIf
      For I = 0 To s-1
        If array_2d(blocked,Width,path_get_x(*path,I),path_get_y(*path,I),dyn)
          ProcedureReturn 0
        EndIf
      Next I
      ProcedureReturn 1
    EndIf
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure.w nearest_node(*path,x,y,distalgo=1)
  min = 2147483647
  sz = path_get_size(*path)
  If sz > 0
    For I = 0 To sz-1
      If distalgo = 1
        s = Sqr(Pow(path_get_x(*path,I)-x,2)+Pow(path_get_y(*path,I)-y,2))
      Else
        xd = path_get_x(*path,I)-x
        yd = path_get_y(*path,I)-y
        If xd < 0
          xd * -1
        EndIf
        If yd < 0
          yd * -1
        EndIf
        s = xd+yd
      EndIf
      If s < min
        min = s
        n = I
      EndIf
    Next I
    ProcedureReturn n
  Else
    ProcedureReturn -1
  EndIf
EndProcedure
Procedure.c save_path(*path,filename.s)
  If *path > 0
    s = MemorySize(*path)
    If s >= 8
      f=CreateFile(#PB_Any,filename)
      WriteData(f,*path,s)
      CloseFile(f)
      ProcedureReturn 1
    EndIf
  EndIf
  ProcedureReturn 0
EndProcedure
Procedure load_path(filename.s)
  sz = FileSize(filename)
  If sz >= 8
    *mem = AllocateMemory(sz)
    f=ReadFile(#PB_Any,filename)
    ReadData(f,*mem,sz)
    CloseFile(f)
    ProcedureReturn *mem
  EndIf
  ProcedureReturn 0
EndProcedure
;}

This is the example that went with it:

Code: Select all

#tileSize = 20

XIncludeFile "pathfinding.pbi"
InitSprite()
InitMouse()
InitKeyboard()
#width = 30
#height = 30

#view_width = 30
#view_height = 30


Global Dim blocked.c(#width-1,#height-1)
Global Dim priority.c(#width-1,#height-1)

Structure monster
  x.l
  y.l
  X2.l
  Y2.l
  xto.l
  yto.l
  speed.c
  Path.l
  num.l
  pathsize.l
EndStructure

Structure player
  x.l
  y.l
  xto.l
  yto.l
  Path.l
EndStructure

Global Dim monster.monster(10)
monster(0)\x = 0
monster(0)\y = 1*#tileSize
monster(0)\speed = Random(5)+1
monster(1)\x = 0
monster(1)\y = 2*#tileSize
monster(1)\speed = Random(5)+1
monster(2)\x = 0
monster(2)\y = 3*#tileSize
monster(2)\speed = Random(5)+1
monster(3)\x = 0
monster(3)\y = 4*#tileSize
monster(3)\speed = Random(5)+1

blocked(1,1) = 1
blocked(1,2) = 1
blocked(1,3) = 1
blocked(1,4) = 1
blocked(1,5) = 1
blocked(1,6) = 1
blocked(8,10) = 1
blocked(12,10) = 1
blocked(12,9) = 1
blocked(11,9) = 1
blocked(10,8) = 1
blocked(10,12) = 1

monsters = 4

Global player.player
player\x = 10*#tileSize
player\y = 10*#tileSize
goto_counter = -1

pathfinding_structure.pathfinding_structure
pathfinding_structure\Width = #width
pathfinding_structure\Height = #height
pathfinding_structure\dynamic = @monster()
pathfinding_structure\dynamic_size = SizeOf(monster)
pathfinding_structure\dynamic_count = monsters
pathfinding_structure\xoff = OffsetOf(monster\x)
pathfinding_structure\yoff = OffsetOf(monster\y)
pathfinding_structure\xto_off = OffsetOf(monster\xto)
pathfinding_structure\yto_off = OffsetOf(monster\yto)
pathfinding_structure\tilesize = #tileSize
pathfinding_structure\blocked = @blocked()
pathfinding_structure\cast_ray = 1
pathfinding_structure\alt_copymemory = 0

Procedure elapsed()
  Static maxfreq.q
  Protected T.q
  If maxfreq=0
    QueryPerformanceFrequency_(@maxfreq)
    maxfreq=maxfreq/1000000
  EndIf
  QueryPerformanceCounter_(@T.q)
  ProcedureReturn T/maxfreq
EndProcedure

Procedure monster_at(x,y,num_monsters,ignore)
  For I = 0 To num_monsters-1
    If I <> ignore
      If monster(I)\x /#tileSize = x And monster(I)\y/#tileSize  = y
        ProcedureReturn I
      EndIf
    EndIf
  Next I
  ProcedureReturn -1
EndProcedure

Procedure goto_player(num_monsters,*pathfinding_structure.pathfinding_structure)
  Shared goto_counter
  Shared average_time_path
  goto_counter + 1
  If goto_counter > num_monsters - 1
    goto_counter = 0
  EndIf
  I = goto_counter
  If monster(I)\Path = 0
    xd = monster(I)\xto-player\x/#tileSize
    yd = monster(I)\yto-player\y/#tileSize
    If xd < 0 : xd * -1 : EndIf
    If yd < 0 : yd * -1 : EndIf
    If xd + yd > 1
      monster(I)\xto = monster(I)\x/#tileSize
      monster(I)\yto = monster(I)\y/#tileSize
      T = elapsed()
      monster(I)\Path = get_path(monster(I)\x/#tileSize,monster(I)\y/#tileSize,player\x/#tileSize,player\y/#tileSize,*pathfinding_structure,I)
      T = elapsed()-T
      If average_time_path > 0
        average_time_path = (T+average_time_path)/2
      Else
        average_time_path = T
      EndIf
      If monster(I)\Path > 0
        monster(I)\pathsize = path_get_size(monster(I)\Path)
        monster(I)\num = 0
        Debug "Got path"
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure walk(num_monsters,*pathfinding_structure.pathfinding_structure)
  Shared average_time_validation
  Shared failed_validations
  For I = 0 To num_monsters-1
    If monster(I)\Path > 0
      m = monster_at(monster(I)\xto,monster(I)\yto,num_monsters,I)
      If m = -1
        m = monster_at(monster(I)\x / *pathfinding_structure\tilesize,monster(I)\y  /*pathfinding_structure\tilesize,num_monsters,I)
      EndIf
      If (monster(I)\x = monster(I)\xto*#tileSize And monster(I)\y = monster(I)\yto *#tileSize) Or m > -1
        If monster(I)\num < monster(I)\pathsize-1 Or m > -1
          If m = -1
            monster(I)\xto = path_get_x(monster(I)\Path,monster(I)\num)
            monster(I)\yto = path_get_y(monster(I)\Path,monster(I)\num)
            monster(I)\num + 1
            T = elapsed()
            v = validate_path(monster(I)\Path,*pathfinding_structure,I)
            T = elapsed()-T
            If average_time_validation > 0
              average_time_validation = (T+average_time_validation)/2
            Else
              average_time_validation = T
            EndIf
          EndIf
          If v = 0 Or m > 0
            failed_validations + 1
            xd = monster(I)\x/#tileSize-player\x/#tileSize
            yd = monster(I)\y/#tileSize-player\y/#tileSize
            If xd < 0 : xd * -1 : EndIf
            If yd < 0 : yd * -1 : EndIf
            If xd + yd > 1
              FreeMemory(monster(I)\Path)
              T = elapsed()
              monster(I)\Path = get_path(monster(I)\x/#tileSize,monster(I)\y/#tileSize,player\x/#tileSize,player\y/#tileSize,*pathfinding_structure,I)
              T = elapsed()-T
              If average_time_path > 0
                average_time_path = (T+average_time_path)/2
              Else
                average_time_path = T
              EndIf
              If monster(I)\Path > 0
                monster(I)\pathsize = path_get_size(monster(I)\Path)
                monster(I)\num = 0
                monster(I)\xto = path_get_x(monster(I)\Path,0)
                monster(I)\yto = path_get_y(monster(I)\Path,0)
              EndIf
            EndIf
          EndIf
        EndIf
      Else
        If monster(I)\x < monster(I)\xto*#tileSize And blocked((monster(I)\x+monster(I)\speed)/#tileSize,monster(I)\y/#tileSize) = 0
          monster(I)\x + monster(I)\speed
          If monster(I)\x > monster(I)\xto*#tileSize
            monster(I)\x = monster(I)\xto*#tileSize
          EndIf
          Continue
        ElseIf monster(I)\x > monster(I)\xto*#tileSize And blocked((monster(I)\x-monster(I)\speed)/#tileSize,monster(I)\y/#tileSize)=0
          monster(I)\x - monster(I)\speed
          If monster(I)\x < monster(I)\xto*#tileSize
            monster(I)\x = monster(I)\xto*#tileSize
          EndIf
          Continue
        EndIf
        
        
        
        If monster(I)\y < monster(I)\yto*#tileSize And blocked(monster(I)\x/#tileSize,(monster(I)\y+monster(I)\speed)/#tileSize)=0
          monster(I)\y + monster(I)\speed
          If monster(I)\y > monster(I)\yto*#tileSize
            monster(I)\y = monster(I)\yto*#tileSize
          EndIf
          Continue
        ElseIf monster(I)\y > monster(I)\yto*#tileSize And blocked(monster(I)\x/#tileSize,(monster(I)\y-monster(I)\speed)/#tileSize)=0
          monster(I)\y - monster(I)\speed
          If monster(I)\y < monster(I)\yto*#tileSize
            monster(I)\y = monster(I)\yto*#tileSize
          EndIf
          Continue
        EndIf
        
      EndIf
    EndIf
  Next I
EndProcedure

Procedure draw(num_monsters)
  Shared average_time_path
  Shared average_time_validation
  Shared failed_validations
  Shared FrameRate
  ClearScreen(#Black)
  StartDrawing(ScreenOutput())
  
  For I = 0 To num_monsters-1
    Box(monster(I)\x,monster(I)\y,#tileSize,#tileSize,#Green)
    DrawingMode(#PB_2DDrawing_Outlined)
    Box(monster(I)\x,monster(I)\y,#tileSize,#tileSize,#White)
    DrawingMode(#PB_2DDrawing_Default)
    If monster(I)\Path > 0
      xx = monster(I)\x
      yy = monster(I)\y
      For z = monster(I)\num To monster(I)\pathsize-1
        x = path_get_x(monster(I)\Path,z)*#tileSize
        y = path_get_y(monster(I)\Path,z)*#tileSize
        LineXY(xx+#tileSize/2,yy+#tileSize/2,x+#tileSize/2,y+#tileSize/2,#White)
        xx = x
        yy = y
      Next z
    EndIf
  Next I
  
  Box(player\x,player\y,#tileSize,#tileSize,#Blue)
  DrawingMode(#PB_2DDrawing_Outlined)
  Box(player\x,player\y,#tileSize,#tileSize,#White)
  DrawingMode(#PB_2DDrawing_Default)
  For x = 0 To #view_width-1
    For y = 0 To #view_height-1
      If blocked(x,y) = 1
        Box(x*#tileSize,y*#tileSize,#tileSize,#tileSize,#Red)
        DrawingMode(#PB_2DDrawing_Outlined)
        Box(x*#tileSize,y*#tileSize,#tileSize,#tileSize,#White)
        DrawingMode(#PB_2DDrawing_Default)
      EndIf
    Next y
  Next x
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(45,5," AVG path generation time: "+StrF(average_time_path/1000,3)+"ms",#White,#Black)
  DrawText(45,5+TextHeight("P")," AVG path validation time: "+StrF(average_time_validation/1000,3)+"ms",#White,#Black)
  DrawText(45,5+TextHeight("P")*2," Failed validations: "+Str(failed_validations),#White,#Black)
  DrawText(45,5+TextHeight("P")*3," FPS: "+Str(FrameRate)+"/40",#White,#Black)
  StopDrawing()
  FlipBuffers(0)
  
EndProcedure

OpenWindow(0,#PB_Ignore,#PB_Ignore,#view_width*#tileSize,#view_height*#tileSize,"Example",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0,0,WindowWidth(0),WindowHeight(0),0,0,0)
SetFrameRate(40)
Repeat
  walk(monsters,pathfinding_structure)
  draw(monsters)
  If ElapsedMilliseconds() < FT
    fps + 1
  Else
    FrameRate = fps
    fps = 0
    FT = ElapsedMilliseconds() + 1000
  EndIf
  If sk = 4
    sk = 0
    goto_player(monsters,pathfinding_structure)
  EndIf
  sk + 1
  Event = WaitWindowEvent(1)
Until Event = #PB_Event_CloseWindow 

[charvista]

Thanks Demivec, however it is a pity that the ASM doesn't work (anymore?).

[luis]

@demivec
Thanks for posting the code

@charvista
Replace all the l_memcpy with l_copymemoryamd_memcpy (17 hits) or simply replace the proc with PB code and remove the ZERO from flipbuffers.

[UUICEO]

Anyone ever able to get this code to work? I'm getting assembler errors with the JMP Ecx instruction.

[kvitaliy]

Anyone ever able to get this code to work? I'm getting assembler errors with the JMP Ecx instruction.

Replace procedure CopyMemoryAMD

Code: Select all

Procedure CopyMemoryAMD(*src, *dst, Size) ;El_Choni wrote this procedure, thanks El_Choni! (made some small changes)
  CopyMemory(*src,*dst, Size)
 EndProcedure

and remove the ZERO from flipbuffers.