A* Pathfinding Algorithm

Game development specific discussions.
Post Reply
Raddel
Posts: 23
Joined: Oct 07, 2007 3:31

A* Pathfinding Algorithm

Post by Raddel »

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
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:

Re: A* Pathfinding Algorithm

Post by Mihail_B »

Here's my algorithm for solving mazes....
I used it for pacman2family...


Download this puzzle image too :Image
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

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)
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: A* Pathfinding Algorithm

Post by Richard »

http://www.freebasic.net/forum/viewtopi ... 65#p112465
Search the forum for pathfinding...
pestery
Posts: 493
Joined: Jun 16, 2007 2:00
Location: Australia

Re: A* Pathfinding Algorithm

Post by pestery »

There is a good page regarding A* pathfinding here, http://theory.stanford.edu/~amitp/GameProgramming/
Raddel
Posts: 23
Joined: Oct 07, 2007 3:31

Re: A* Pathfinding Algorithm

Post by Raddel »

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
Post Reply