Hello all,
i m finding A* algorithm or A* tutorial in freebasic.. Does anyone know?
And i help for translate from c++ into freebasic at http://code.google.com/p/a-star-algorit ... loads/list. I have use h_2_bi but i still cant get it. Thank you.
Best Regards,
Raddel
A* Pathfinding Algorithm
Re: A* Pathfinding Algorithm
Here's my algorithm for solving mazes....
I used it for pacman2family...
Download this puzzle image too :
Get the code below.
Compile and run the program.
The program will ask you for a BMP file that holds the puzzle: enter your bmp file name.
The program will load the BMP on screen and wait for the user to click mouse at starting position and then click mouse
at ending position (for each click you should hear a BEEP).
After clicking press any key ...
Enjoy !
The algorithm is based upon "breadh first" path finding and "dijkstra" path finding .... It's a simplified dijkstra for matrix puzzles ...
What it needs ? A matrix where 0 means walkable and 1 means un-walkable .(the code below has got an internal functions which will convert from BMP to this matrix.
How does it works :
1) you are at the initial position
2) insert in linked list all the neighborns of your current position (the linked list elemet should contain: X, Y and pointer to neighborn linked list structure)
3) for all points in the linked list mark them visited and then insert their neighborns in a new linked list
4) take the new list a set it as default; go to step 3 until there's no-one visit any longer OR until you've arrived at the destination
5) from the arrivel point (if there exist one) go back point by point using the linked list's neighborn pointer structure !
that's it !
If you want to use the algorithm for yourself please see/use function:
Sub getshortestpath_thread(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte Ptr,slepy As Integer)
I used it for pacman2family...
Download this puzzle image too :
Get the code below.
Compile and run the program.
The program will ask you for a BMP file that holds the puzzle: enter your bmp file name.
The program will load the BMP on screen and wait for the user to click mouse at starting position and then click mouse
at ending position (for each click you should hear a BEEP).
After clicking press any key ...
Enjoy !
The algorithm is based upon "breadh first" path finding and "dijkstra" path finding .... It's a simplified dijkstra for matrix puzzles ...
What it needs ? A matrix where 0 means walkable and 1 means un-walkable .(the code below has got an internal functions which will convert from BMP to this matrix.
How does it works :
1) you are at the initial position
2) insert in linked list all the neighborns of your current position (the linked list elemet should contain: X, Y and pointer to neighborn linked list structure)
3) for all points in the linked list mark them visited and then insert their neighborns in a new linked list
4) take the new list a set it as default; go to step 3 until there's no-one visit any longer OR until you've arrived at the destination
5) from the arrivel point (if there exist one) go back point by point using the linked list's neighborn pointer structure !
that's it !
Code: Select all
'
' Shortest Path (G)
' Gnupyright (G) 1996-2011, AlphaX (R) Team
' programmed by Mihai Barboi (aka Zdupy), Romania, Eu
' mail_me at: mbarboi@home.ro
' WWW : http://mbarboi.home.ro
'
' For license please read "The Universal Declaration of Human Rights" & GPL V2...
'
' It's my own implementation ... but I was inspired from MIT's OCWs 6.004,6.111,6.046 and other docs...
'
' This program can be used to compute the shortest path and the steps needed to
' take in order to solve any kind of MAZE map... !
'
' The input file is simply text...
'1) first line should contain MAP width and length in ascii chars, each num separated by space.
'2) second line contains starting position (in ascii chars, each num separated by space)
'3) third line contains final position (in ascii chars, each num separated by space :) )
'4) n lines (where n=hight) containing x numbers (where x=WIDTH) (in ascii chars, each num separated by space)
'
' Program will display:
' - number of cycles for shortest path (aka number of steps)
' - the steps in reverse order (from end to begining) (map coordonates)
' - number of pointes processed at each step ... (for statistics)
'
' Program speed ... : it will take a maximum of [worst_case_speed=WIDTH*HEIGHT] steps/cycles to find final point
' Memory used : you will need ~=WIDTH*HEIGHT*(2+(len(stepaside)) in the WORST case...
'
' Notes : Worst case (width*height) is actually imposible ... Instead program might
' need to pass ONCE in each map's point ! (That's way you might need ~=WIDTH*HEIGHT*(2+(len(stepaside)))
'
'
'Example of map: [shortedp.txt]
'8 8
'1 1
'8 8
'0 0 0 0 1 0 0 0
'0 1 0 0 1 0 0 0
'0 0 0 0 0 0 1 0
'0 0 0 0 1 1 1 0
'0 0 0 0 1 0 0 0
'0 0 0 0 1 0 1 1
'0 0 0 0 1 0 0 0
'0 0 0 0 1 0 0 0
'
' Final answer : 13 cycles(+1) (+1 because I consider starting position as a cycle :) )
' Steps : (8,8) <- (7,7) <- (6,6) <- (7,5) <- (8,4) <- (8,3) <-(7,2) <- (6,3) <- (5,3) <- (4,2) <- (3,1) <- (2,1) <- (1,1)
' Statistics :
' [cycle]:[points processed each cycle]
' 1 :1
' 2 :2
' 3 :5
' 4 :7
' 5 :6
' 6 :6
' 7 :7
' 8 :7
' 9 :1
' 10 :2
' 11 :2
' 12 :2
' 13 :4
'
' BMP files: You can load also BMP files !
' Walking regions are marked with black while not walkable places are marked with
' any other color !
' Using BMP :
' 1) After entering BMP filename (and path) use MOUSE to select DOWN-RIGHT corner (click mouse)!
' 2) Next click the starting point
' 3) Click the ending point
' 4) press any key ...
'
'
' You are free to use this program for pacefull purposes only and if you agree
' with the universal decalaration of human right !
' You can use this algorithm in games similar to dune2 or whatever but
' don't forget : games are games (fun) , but life is life (real life war is painful and stupid)
'
' Procedure getshortestpath(...) can be used to simply get the shortest path
' when having an bitmap ... and some coordonates.
'
' getshortestpath(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer ptr)
' parameters : img1 -> image (created using FB createimage(..))
' sx, sy -> starting position
' ex, ey -> ending position
' diagonala -> if this variable is 0 : walk up/down/left/right
' if this variable is 1 : walp up/down/left/right AND to corners (UP-LEFT,UP-RIGHT,DOWN-LEFT,DOWN-RIGHT)
'To do (for me):
'Implement an optimization:
' -> if curent algorithm is used num[memoryused]=num[steps]=pi*Distance^2
' -> if optimized num[memused_optimized]=num[steps_optimized]=2*(pi*(Distance/2)^2)=(pi*Distance^2/2) -> 2 times faster,2 times less memory used ! (4xquality !)
' How to implement optimization ?
' *** Start inserting neigborns from both sides (final point & starting point) ! ***
'
' Optimization (level 0)
' -> normal programming optimizations : using simplified calculations and all other compiler like optimizations
' -> other optimizations and tricks
' *******
' ** **
' ** **
' * * (F) - final point
' * * (I) - initial point
' * F I distance=[FI]
' * * area=pi*[FI]^2
' * *
' ** **
' ** **
' *******
'
'
' Optimizations (level 1)
' *** ***
' ** ** ** ** (F) - final point
' * * * (I) - initial point
' * F * I * distance=[FI]
' * * * area=(pi*[FI/2]^2)+(pi*[FI/2]^2)=pi*[FI^2]/2
' ** ** ** **
' *** *** => 2x times less operations, 2x times less memory used
'
'
' Optimizations (level 2)
'|** **|
'| ** ** | (F) - final point
'| * | (I) - initial point
'|F * I| distance=[FI]
'| * | area=(pi*[FI/2]^2)/2+(pi*[FI/2]^2)/2=pi*[FI^2]/4
'| ** ** |
'|** **| => 4x times less operations, 4x times less memory used
' &&& and further if posible &&&
'----------- (F) - final point
'| * | (I) - initial point
'|F * I| distance=[FI]
'| * | area=(pi*[FI/2]^2)/4+(pi*[FI/2]^2)/4=pi*[FI^2]/8
'----------- => 8x times less operations, 8x times less memory used
'
'
' Optimizations (level 3)
' # arhitecture independent optimizations -> multiple processors (at least DualCore)
' -> DualCore => for each processors program assigns a "searching" procedure (e.g. cpu one : starts from initial position; cpu two : starts from final position)
' --> 2x times faster then single cpu
' -> TriCore => like DualCore but another cpu verifies only if any of the points inserted by each processor are common
' --> 3(?)x times faster then single cpu
' -> QuadCore => like TriCore but another cpu can do auxiliar stuff to speed up things.
' --> 4(?)x times faster then single cpu
' # other multi-processor optimizations ...
'
' ______________________________________________________________________________________________________________________________________
' Maximum optimizations speed up (QuadCore) -> 32x times faster; 8x times less memory used; 2x upto 4x times less energy used (quadcore)
' Average optimizations speed up (singleCore) -> 4x upto 8x times less operations; 4x upto 8x times less memory used
' Worst case optimizations speed up (1xcpu) -> 2x times less operationsl; 2x times less memory used
' --------------------------------------------------------------------------------------------------------------------------------------
'
' Optimizations (level 4)
' # ...??? ... I ain't got that far, yet ...!!!
' # probably a better algorithm (??)
'#Include Once "mem.bas"
Type setpasideP As stepaside
Type stepaside
parent As stepaside Ptr
As Integer x,y
brother As stepaside Ptr
End Type
Declare Sub do_test_of_shortestpas()
Declare Sub getshortestpath(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte ptr)
Declare Sub getshortestpath_thread(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte Ptr,slepy As Integer)
Declare Sub getshortestpath_threaddisplay(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte Ptr,slepy As Integer, printing_func As Any ptr)
'#Define no_shortesp_exe
#Ifndef no_shortesp_exe
do_test_of_shortestpas()
End
#EndIf
sub rdtsc1(i as ulongint ptr)
Asm
push eax
push edx
push ecx
rdtsc
mov ecx,[i]
mov [ecx],eax
mov [ecx+4],edx
pop ecx
pop edx
pop eax
End asm
end Sub
sub movsb1(src as any ptr,dst as any ptr,l as uinteger)
Asm
push esi
push edi
push ecx
pushf
mov esi,[src]
mov edi,[dst]
mov ecx,[l]
cld
rep movsb
popf
pop ecx
pop edi
pop esi
End Asm
end sub
Sub getshortestpath(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte ptr)
Dim As Integer i,k,f,j,h,t,l,m,inserted
Dim As Integer mx,my,map_size
Dim As stepaside Ptr sa, sap, sap2
Dim As Integer steps_total,mused
Dim As String A
Dim as double tt1,tt2
Dim as ulongint td1,td2
ImageInfo img1,mx,my
map_size=mx*my
Dim As UByte did(1 To mx, 1 To my)
Dim As UInteger steps_count(1 To map_size+1024)
Dim As stepaside Ptr steps(1 To map_size+1024)
If map2=0 then
map2=allocate(map_size+8)
mused=1
'Dim As UByte map(1 To mx,1 To my)
'ex+=1:ey+=1:sx+=1:sy+=1 '
For k=0 To my-1
For i=0 To mx-1
'map(i,k)=iif((Point(i-1,k-1,img1) And &hffffff)>0,1,0)
map2[i +(k)*mx]=iif((Point(i,k,img1) And &hffffff)>0,1,0)
Next i
Next k
End if
steps_total=1
steps_count(steps_total)=1
steps(steps_total)=cAllocate(Len(stepaside))
sa=steps(steps_total)
sa->parent=0
sa->x=sx
sa->y=sy
did(sa->x,sa->y)=1
l=steps_total
m=l+1
sa=steps(l)
If (sx=ex) And (sy=ey) Then
Print "starting position is equal with final one ! No work to do ..."
Exit Sub
EndIf
'print "starting ..." 'debugx
'tt1=timer()
'rdtsc1 @td1
redo11122:
inserted=0
For k=1 To steps_count(L)
If sa=0 Then Exit For
If sa->x>1 Then 'left
'If (map(sa->x-1,sa->y)= 0) And (did(sa->x-1,sa->y)=0) Then
If (map2[sa->x-1 + (sa->y-1)*mx -1]= 0) And (did(sa->x-1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If sa->x < mx Then 'right
'If (map(sa->x+1,sa->y)= 0) And (did(sa->x+1,sa->y)=0) Then
If (map2[sa->x+1 + (sa->y-1)*mx -1]= 0) And (did(sa->x+1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If sa->y > 1 Then 'down (or "up of screen")
'If (map(sa->x,sa->y-1)=0) And (did(sa->x,sa->y-1)=0) Then
If (map2[sa->x + (sa->y-1-1)*mx -1]= 0) And (did(sa->x,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y-1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If sa->y <my Then 'up (or "down of screen")
'If (map(sa->x,sa->y+1)= 0) And (did(sa->x,sa->y+1)=0) Then
If (map2[sa->x + (sa->y+1-1)*mx -1]= 0) And (did(sa->x,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y+1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If diagonala=1 Then
If (sa->x > 1) And (sa->y > 1) Then ' down and left (or "up" and left)
'If (map(sa->x-1,sa->y-1)=0) And (did(sa->x-1,sa->y-1)=0) Then
If (map2[sa->x-1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x-1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y-1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x < mx) And (sa->y > 1) Then 'down and right (or "up" and right)
'If (map(sa->x+1,sa->y-1)=0) And (did(sa->x+1,sa->y-1)=0) Then
If (map2[sa->x+1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x+1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y-1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x > 1) And (sa->y < my) Then 'up and left (or "down" and left)
'If (map(sa->x-1,sa->y+1)=0) And (did(sa->x-1,sa->y+1)=0) Then
If (map2[sa->x-1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x-1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y+1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x < mx) And (sa->y < my) Then 'up and right (or "down" and right)
'If (map(sa->x+1,sa->y+1)=0) And (did(sa->x+1,sa->y+1)=0) Then
If (map2[sa->x+1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x+1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y+1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
EndIf
sa=sa->brother
Next k
If (inserted=0) Or (m=map_size+1000) Then goto finish22
l=m
sa=steps(l)
steps_total=l
m=l+1
GoTo redo11122
ifound122:
steps_total=m
'rdtsc1 @td2
'tt2=timer()
*thestepstotal=steps_total
If thesteps=0 Then GoTo finish22
Dim As stepaside Ptr ttt
*CPtr(UInteger Ptr,thesteps)=Cast(UInteger,Allocate(Len(stepaside)*steps_total+4))
ttt=*CPtr(UInteger Ptr,thesteps)
While sap<>0
m-=1
sap->x-=1:sap->y-=1
movsb1 sap,@ttt[m],Len(stepaside)
sap=sap->parent
Wend
finish22:
For i=1 to steps_total
sa=steps(i)
while sa<>0
sap=sa
sa=sa->brother
deallocate sap
wend
Next i
If mused=1 Then DeAllocate map2
'Print "#!@$ !"
End Sub
Sub getshortestpath_thread(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte Ptr,slepy As Integer)
Dim As Integer i,k,f,j,h,t,l,m,inserted
Dim As Integer mx,my,map_size
Dim As stepaside Ptr sa, sap, sap2
Dim As Integer steps_total,mused
Dim As String A
Dim as double tt1,tt2
Dim as ulongint td1,td2
ImageInfo img1,mx,my
map_size=mx*my
Dim As UByte did(1 To mx, 1 To my)
Dim As UInteger steps_count(1 To map_size+1024)
Dim As stepaside Ptr steps(1 To map_size+1024)
If map2=0 then
map2=allocate(map_size+8)
mused=1
For k=0 To my-1
For i=0 To mx-1
map2[i +(k)*mx]=iif((Point(i,k,img1) And &hffffff)>0,1,0)
Next i
Next k
End if
steps_total=1
steps_count(steps_total)=1
steps(steps_total)=Allocate(Len(stepaside))
sa=steps(steps_total)
sa->parent=0
sa->x=sx
sa->y=sy
sa->brother=0
did(sa->x,sa->y)=1
l=steps_total
m=l+1
sa=steps(l)
If (sx=ex) And (sy=ey) Then
#Ifndef _shortestp_dont_talk
Print "starting position is equal with final one ! No work to do ..."
#EndIf
Exit Sub
EndIf
'print "starting ..." 'debugx
'tt1=timer()
'rdtsc1 @td1
redo11122:
inserted=0
For k=1 To steps_count(L)
If sa=0 Then Exit For
If sa->x>1 Then 'left
'If (map(sa->x-1,sa->y)= 0) And (did(sa->x-1,sa->y)=0) Then
If (map2[sa->x-1 + (sa->y-1)*mx -1]= 0) And (did(sa->x-1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If sa->x < mx Then 'right
'If (map(sa->x+1,sa->y)= 0) And (did(sa->x+1,sa->y)=0) Then
If (map2[sa->x+1 + (sa->y-1)*mx -1]= 0) And (did(sa->x+1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If sa->y > 1 Then 'down (or "up of screen")
'If (map(sa->x,sa->y-1)=0) And (did(sa->x,sa->y-1)=0) Then
If (map2[sa->x + (sa->y-1-1)*mx -1]= 0) And (did(sa->x,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y-1
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If sa->y <my Then 'up (or "down of screen")
'If (map(sa->x,sa->y+1)= 0) And (did(sa->x,sa->y+1)=0) Then
If (map2[sa->x + (sa->y+1-1)*mx -1]= 0) And (did(sa->x,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y+1
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If diagonala=1 Then
If (sa->x > 1) And (sa->y > 1) Then ' down and left (or "up" and left)
'If (map(sa->x-1,sa->y-1)=0) And (did(sa->x-1,sa->y-1)=0) Then
If (map2[sa->x-1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x-1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y-1
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x < mx) And (sa->y > 1) Then 'down and right (or "up" and right)
'If (map(sa->x+1,sa->y-1)=0) And (did(sa->x+1,sa->y-1)=0) Then
If (map2[sa->x+1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x+1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y-1
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x > 1) And (sa->y < my) Then 'up and left (or "down" and left)
'If (map(sa->x-1,sa->y+1)=0) And (did(sa->x-1,sa->y+1)=0) Then
If (map2[sa->x-1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x-1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y+1
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x < mx) And (sa->y < my) Then 'up and right (or "down" and right)
'If (map(sa->x+1,sa->y+1)=0) And (did(sa->x+1,sa->y+1)=0) Then
If (map2[sa->x+1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x+1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y+1
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
EndIf
sa=sa->brother
Next k
If (inserted=0) Or (m=map_size+1000) Then goto finish22
l=m
sa=steps(l)
steps_total=l
m=l+1
If slepy>0 Then Sleep slepy
GoTo redo11122
ifound122:
steps_total=m
'rdtsc1 @td2
'tt2=timer()
*thestepstotal=steps_total
If thesteps=0 Then GoTo finish22
Dim As stepaside Ptr ttt
*CPtr(UInteger Ptr,thesteps)=Cast(UInteger,Allocate(Len(stepaside)*(steps_total+1)+4))
ttt=*CPtr(UInteger Ptr,thesteps)
If sap<>0 Then
movsb1 sap,@ttt[m],Len(stepaside) 'we add one more step with the same coordanates as last step to increase speed of some procs
CPtr(stepaside Ptr,@ttt[m])->x-=1
CPtr(stepaside Ptr,@ttt[m])->y-=1
EndIf
While sap<>0
m-=1
sap->x-=1:sap->y-=1
movsb1 sap,@ttt[m],Len(stepaside)
sap=sap->parent
Wend
finish22:
For i=1 to steps_total
sa=steps(i)
while sa<>0
sap=sa
sa=sa->brother
deallocate sap
wend
Next i
If mused=1 Then DeAllocate map2
'Print "#!@$ !"
End Sub
Sub do_test_of_shortestpas()
Dim As String mpf
Dim As Integer i,k,f,j,h,t,l,m,inserted,graphy,loadbmp_3
Dim As Integer mx,my,sx,sy,ex,ey,diagonala,map_size
Dim As stepaside Ptr sa, sap, sap2
Dim As Integer steps_total
Dim As String A
dim as double tt1,tt2
dim as ulongint td1,td2
Dim As Any Ptr img1
graphy=1
mpf=Command(1)
while mpf="" Or Dir(mpf)=""
Line Input "map file:",mpf
If mpf="" Then
Beep
end
EndIf
Wend
If InStr(mpf,".bmp")>0 Then
loadbmp_3=1
Screen 18,16,,1
graphy=1
img1=ImageCreate(1200,1200,0,16)
BLoad mpf,img1
Put (0,0),img1
Else
loadbmp_3=0
EndIf
diagonala=1 'walk also 45*x degrades
If loadbmp_3=0 Then
f=FreeFile
Open mpf For Input As #f
Input #f, mx, my 'map width and height
Input #f, sx, sy 'start point
Input #f, ex, ey 'end point
map_size=mx*my
j=0
If my>mx then
j=mx : mx=my : my=j
j=sx : sx=sy : sy=j
j=ex : ex=ey : ey=j
j=1
End If
Else
/'
While j=0
GetMouse mx,my,,j
Sleep 10
Wend
'/
ScreenInfo mx,my
mx-=1:my-=1
Line (0,my)-(mx,my),RGB(255,255,255)
Line (mx,0)-(mx,my),RGB(255,255,255)
Sleep 240
a=inkey
GetMouse i,k,,j
j=0
While j=0
GetMouse sx,sy,,j
Sleep 10
Wend
beep
Sleep 240
GetMouse i,k,,j
a=InKey
j=0
While j=0
GetMouse ex,ey,,j
Sleep 10
Wend
beep
'Input "walk also on diagonal? (0=no,1=yes):",diagonala
map_size=mx*my
j=0
End If
dim As UByte map(1 To mx,1 To my)
Dim As UByte did(1 To mx, 1 To my)
Dim As UInteger steps_count(1 To map_size+1024)
Dim As stepaside Ptr steps(1 To map_size+1024)
If loadbmp_3=0 Then
If j=0 then
For k=1 To my
For i=1 To mx
Input #f, map(i,k) 'load map, one line at once
Next i
Next k
Else
For k=1 To mx
For i=1 To my
Input #f, map(k,i) 'load map, one line at once
Next i
Next k
End if
Close #f
Else 'for bmp
For k=1 To my
For i=1 To mx
map(i,k)=iif((Point(i-1,k-1,img1) And &hffffff)>0,1,0)
Next i
Next k
End If
steps_total=1
steps_count(steps_total)=1
steps(steps_total)=cAllocate(Len(stepaside))
sa=steps(steps_total)
sa->parent=0
sa->x=sx
sa->y=sy
l=steps_total
m=l+1
sa=steps(l)
If (sx=ex) And (sy=ey) Then
Print "starting position is equal with final one ! No work to do ..."
Beep
a=InKey:While a="" : a=InKey :Sleep 25:Wend
Beep
end
EndIf
print "starting ..." 'debugx
tt1=timer()
rdtsc1 @td1
redo111:
inserted=0
For k=1 To steps_count(L)
If sa=0 Then Exit For
If sa->x>1 Then 'left
If (map(sa->x-1,sa->y)= 0) And (did(sa->x-1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
EndIf
If sa->x < mx Then 'right
If (map(sa->x+1,sa->y)= 0) And (did(sa->x+1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
End If
If sa->y > 1 Then 'down (or "up of screen")
If (map(sa->x,sa->y-1)=0) And (did(sa->x,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y-1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
End If
If sa->y <my Then 'up (or "down of screen")
If (map(sa->x,sa->y+1)= 0) And (did(sa->x,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y+1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
End If
If diagonala=1 Then
If (sa->x > 1) And (sa->y > 1) Then ' down and left (or "up" and left)
If (map(sa->x-1,sa->y-1)=0) And (did(sa->x-1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y-1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
EndIf
If (sa->x < mx) And (sa->y > 1) Then 'down and right (or "up" and right)
If (map(sa->x+1,sa->y-1)=0) And (did(sa->x+1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y-1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
EndIf
If (sa->x > 1) And (sa->y < my) Then 'up and left (or "down" and left)
If (map(sa->x-1,sa->y+1)=0) And (did(sa->x-1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y+1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
EndIf
If (sa->x < mx) And (sa->y < my) Then 'up and right (or "down" and right)
If (map(sa->x+1,sa->y+1)=0) And (did(sa->x+1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=callocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=callocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y+1
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound1
EndIf
EndIf
EndIf
sa=sa->brother
Next k
If (inserted= 0) Or (m=map_size) Then goto finish
l=m
sa=steps(l)
steps_total=l
m=l+1
GoTo redo111
ifound1:
steps_total=m
rdtsc1 @td2
tt2=timer()
if (graphy=1) And (loadbmp_3=0) Then Screen 18,16
If graphy=1 then
for k=1 to my
for i=1 to mx
if map(i,k)=0 then pset (i,k),0 else pset (i,k),rgb(255,255,255)
next i
next k
a=InKey:While a="" : a=InKey :Sleep 25:Wend
sap2=sap
While sap2<>0
pset (sap2->x,sap2->y),rgb(200,100,10)
sap2=sap2->parent
if (mx>200) and (my>100) then sleep 5 else sleep 20
Wend
a=InKey:While a="" : a=InKey :Sleep 25:Wend
For i=1 To steps_total
sap2=steps(i)
While sap2<>0
PSet (sap2->x,sap2->y),RGB(100,200,10)
sap2=sap2->brother
Wend
Sleep 25
Next i
end if
Print "we started at :";sx;",";sy
Print "need to go as fast as we can to :";ex;",";ey
Print "we arrived at end position in :";m;" cycles (plus +1 cycle because ...)!"
print "d(t)=";tt2-tt1;" dTim=";td2-td1
a=InKey:While a="" : a=InKey :Sleep 25:Wend
While sap<>0
Print "[";sap->x;",";sap->y;"]";
If Not((sap->x=sx) And (sap->y=sy)) Then Print "<-",
sap=sap->parent
Wend
Print
a=InKey:While a="" : a=InKey :Sleep 25:Wend
Print "for each cycle there were :"
t=0
For i=1 To steps_total
Print i;":";steps_count(i),
t+=steps_count(i)
Next i
a=InKey:While a="" : a=InKey :Sleep 25:Wend
Print
Print "shortest path :";steps_total
finish:
Print "map size (points):";map_size
Print "points processed :";t;" (each of this 'processed' points is only once loaded in memory!)"
print "d(t)=";tt2-tt1;" dTim=";td2-td1
Beep
a=InKey:While a="" : a=InKey :Sleep 25:Wend
For i=1 to steps_total
sa=steps(i)
while sa<>0
sap=sa
sa=sa->brother
deallocate sap
wend
next i
BLoad mpf,img1
Dim As Any Ptr img2=ImageCreate(mx,my,0,16)
Get img1,(0,0)-(mx-1,my-1),img2
Cls
Print "entering [!]"
getshortestpath img2,sx,sy,ex,ey,diagonala,@sap,@i,0
sap2=sap
Put (0,0),img2,PSet
For j=1 To i-1
PSet(sap[j].x,sap[j].y),RGB(0,255,0)
Next j
a=InKey:While a="" : a=InKey :Sleep 25:Wend
Print "f=";i;" ==";steps_total
For j=1 To i-1
Print "[";sap[j].x;",";sap[j].y;"]";
If Not((sap[j].x=sx) And (sap[j].y=sy)) Then Print "<-",
Next j
Beep
a=InKey:While a="" : a=InKey :Sleep 25:Wend
If loadbmp_3=1 Then ImageDestroy img1
If loadbmp_3=1 Then ImageDestroy img2
DeAllocate sap2
If graphy=1 Then Screen 0
End Sub
Sub getshortestpath_threaddisplay(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte Ptr,slepy As Integer, printing_func As Any ptr)
Dim As Integer i,k,f,j,h,t,l,m,inserted
Dim As Integer mx,my,map_size
Dim As stepaside Ptr sa, sap, sap2
Dim As Integer steps_total,mused
Dim As String A
Dim as double tt1,tt2
Dim as ulongint td1,td2
Dim prn_f As Sub(x As Integer, y As Integer, l As Integer)
prn_f=printing_func
ImageInfo img1,mx,my
map_size=mx*my
Dim As UByte did(1 To mx, 1 To my)
Dim As UInteger steps_count(1 To map_size+1024)
Dim As stepaside Ptr steps(1 To map_size+1024)
If map2=0 then
map2=allocate(map_size+8)
mused=1
For k=0 To my-1
For i=0 To mx-1
map2[i +(k)*mx]=iif((Point(i,k,img1) And &hffffff)>0,1,0)
Next i
Next k
End if
steps_total=1
steps_count(steps_total)=1
steps(steps_total)=Allocate(Len(stepaside))
sa=steps(steps_total)
sa->parent=0
sa->x=sx
sa->y=sy
sa->brother=0
did(sa->x,sa->y)=1
l=steps_total
m=l+1
sa=steps(l)
If (sx=ex) And (sy=ey) Then
#Ifndef _shortestp_dont_talk
Print "starting position is equal with final one ! No work to do ..."
#EndIf
Exit Sub
EndIf
'print "starting ..." 'debugx
'tt1=timer()
'rdtsc1 @td1
redo11122:
inserted=0
For k=1 To steps_count(L)
If sa=0 Then Exit For
If sa->x>1 Then 'left
'If (map(sa->x-1,sa->y)= 0) And (did(sa->x-1,sa->y)=0) Then
If (map2[sa->x-1 + (sa->y-1)*mx -1]= 0) And (did(sa->x-1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If sa->x < mx Then 'right
'If (map(sa->x+1,sa->y)= 0) And (did(sa->x+1,sa->y)=0) Then
If (map2[sa->x+1 + (sa->y-1)*mx -1]= 0) And (did(sa->x+1,sa->y)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If sa->y > 1 Then 'down (or "up of screen")
'If (map(sa->x,sa->y-1)=0) And (did(sa->x,sa->y-1)=0) Then
If (map2[sa->x + (sa->y-1-1)*mx -1]= 0) And (did(sa->x,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y-1
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If sa->y <my Then 'up (or "down of screen")
'If (map(sa->x,sa->y+1)= 0) And (did(sa->x,sa->y+1)=0) Then
If (map2[sa->x + (sa->y+1-1)*mx -1]= 0) And (did(sa->x,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x
sap->y=sa->y+1
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
End If
If diagonala=1 Then
If (sa->x > 1) And (sa->y > 1) Then ' down and left (or "up" and left)
'If (map(sa->x-1,sa->y-1)=0) And (did(sa->x-1,sa->y-1)=0) Then
If (map2[sa->x-1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x-1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y-1
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x < mx) And (sa->y > 1) Then 'down and right (or "up" and right)
'If (map(sa->x+1,sa->y-1)=0) And (did(sa->x+1,sa->y-1)=0) Then
If (map2[sa->x+1 + (sa->y-1-1)*mx -1]= 0) And (did(sa->x+1,sa->y-1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y-1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y-1
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x > 1) And (sa->y < my) Then 'up and left (or "down" and left)
'If (map(sa->x-1,sa->y+1)=0) And (did(sa->x-1,sa->y+1)=0) Then
If (map2[sa->x-1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x-1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x-1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x-1
sap->y=sa->y+1
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
If (sa->x < mx) And (sa->y < my) Then 'up and right (or "down" and right)
'If (map(sa->x+1,sa->y+1)=0) And (did(sa->x+1,sa->y+1)=0) Then
If (map2[sa->x+1 + (sa->y+1-1)*mx -1]= 0) And (did(sa->x+1,sa->y+1)=0) Then
inserted=1
steps_count(m)+=1
did(sa->x+1,sa->y+1)=1
If steps_count(m)=1 Then
steps(m)=Allocate(Len(stepaside))
sap=steps(m)
Else
sap->brother=Allocate(Len(stepaside))
sap=sap->brother
EndIf
sap->parent=sa
sap->x=sa->x+1
sap->y=sa->y+1
If prn_f<>0 Then prn_f(sap->x,sap->y,l)
sap->brother=0
If (sap->x=ex) And (sap->y=ey) Then GoTo Ifound122
EndIf
EndIf
EndIf
sa=sa->brother
Next k
If (inserted=0) Or (m=map_size+1000) Then goto finish22
l=m
sa=steps(l)
steps_total=l
m=l+1
If slepy>0 Then Sleep slepy
GoTo redo11122
ifound122:
steps_total=m
'rdtsc1 @td2
'tt2=timer()
*thestepstotal=steps_total
If thesteps=0 Then GoTo finish22
Dim As stepaside Ptr ttt
*CPtr(UInteger Ptr,thesteps)=Cast(UInteger,Allocate(Len(stepaside)*steps_total+4))
ttt=*CPtr(UInteger Ptr,thesteps)
While sap<>0
m-=1
sap->x-=1:sap->y-=1
movsb1 sap,@ttt[m],Len(stepaside)
sap=sap->parent
Wend
finish22:
For i=1 to steps_total
sa=steps(i)
while sa<>0
sap=sa
sa=sa->brother
deallocate sap
wend
Next i
If mused=1 Then DeAllocate map2
'Print "#!@$ !"
End Sub
Type costx
As Integer cost
As Integer to_who
End Type
Type cycle
As costx c
As cycle Ptr next1
As cycle Ptr parent
End Type
Type stepbeside
As costx C
As cycle Ptr parent
End Type
Sub getshortestpathbycost(num_city As Integer,starting_city As Integer,ending_city As Integer, cost As Integer Ptr,path As stepbeside Ptr)
Dim As costx Ptr Ptr city
Dim As Integer i,k,num_i,max_cost
Dim As cycle Ptr cyc,acyc,vcyc
Dim As Integer curent_cycle
Dim As Integer Ptr n
num_city=100 'given
max_cost=100 'we should find this from data
city=Allocate(num_city Shl 2)
n=Allocate(num_city Shl 2)
i=0
While i<num_city
num_i=CInt((num_i-1)*Rnd) '=how many neighborns has this city
n[i]=num_i
city[i]=Allocate(num_i*Len(costx))
k=0
While k<n[num_i]
((city[i])[k]).to_who=CInt((num_city-1)*Rnd)
((city[i])[k]).cost=CInt(1+(max_cost-1)*Rnd)
k+=1
Wend
i+=1
Wend
cyc=Allocate(num_city*len(cycle))
curent_cycle=0
/'
cyc[curent_cycle].c.to_who=starting_city
cyc[curent_cycle].c.cost=0\
cyc[curent_cycle].next1=0
cyc[curent_cycle].parent=0
Do
acyc=@cyc[curent_cycle]
curent_cycle+=1
vcyc=@cyc[curent_cycle]
While acyc<>0
i=0
While i<n[i]
vcyc->c.to_who=city[/
vcyc->
i+=1
Wend
acyc=acyc->next1
Wend
Loop
'/
'this is easy /// all I have to do is to extend costs like they are path
'of some length (e.g cost=5 : 5 units = a line with len 5; line is separated from
'others)
'then I just have to go one unit at a time as in my previous algorihm
'(it's a modified breadth search - I will call it parallel breadth search
End Sub
Sub getshortestpath_thread(img1 As Any Ptr,sx As Integer,sy As Integer, ex As Integer,ey As UInteger,diagonala As Integer, thesteps As Any Ptr, thestepstotal As Integer Ptr, map2 As UByte Ptr,slepy As Integer)
Re: A* Pathfinding Algorithm
http://www.freebasic.net/forum/viewtopi ... 65#p112465
Search the forum for pathfinding...
Search the forum for pathfinding...
Re: A* Pathfinding Algorithm
There is a good page regarding A* pathfinding here, http://theory.stanford.edu/~amitp/GameProgramming/
Re: A* Pathfinding Algorithm
Hello,
@pestery : tks.. i have reading that before.
@richard : thanks too... but i dont get it whats that program.
@Mihail : Wow thats awesome man... really.. tks..
i have sure find A* in freebasic.. some how i browsing in few moment before login in forum then some how mr google show me this
http://www.execulink.com/~coder/freebasic/astar.html.
Many thanks for all
Best Regards,
Raddel
@pestery : tks.. i have reading that before.
@richard : thanks too... but i dont get it whats that program.
@Mihail : Wow thats awesome man... really.. tks..
i have sure find A* in freebasic.. some how i browsing in few moment before login in forum then some how mr google show me this
http://www.execulink.com/~coder/freebasic/astar.html.
Many thanks for all
Best Regards,
Raddel