Code archives/Algorithms/simple a* pathfinding
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Here is my first attempt at a* pathfinding. It's not very skillfully written, but I hope it helps someone. I did this about a week ago when I finally returned to programming. A* pathfinding is actually the reason I stopped for so long... I couldn't figure it out so I felt like I was to stupid to program games. I feel slightly better now. I got it working thanks to one long night, alot of coffee and some reading. controls: left mouse button = select starting point. right mouse button = select goal point. hold down "1" to show how the path is worked out. and "esc" quits it. | |||||
;A* pathfinding attempt 1 ;Put together by Kevin Laherty. ( kalisme@hotmail.com ) ;based on an article by Patrick Lester,(hosted on GameDev.net) Graphics 640,480 SetBuffer BackBuffer() Dim r_map(21,21) ;<- for the in game map Dim a_map(21,21,5) ;<- for the A* pathfinder path$="s" ;<- the current path our li'l fella has to ; go to reach his goal. "s" means it has no goal or it is unreachable. Global s_x=2,s_y=2 ;starting point X & Y (current location of our li'l fella) Global e_x,e_y ;exit point X & Y (where we aim to get to) .map_data Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ;<- just our map. Data 1,0,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1 ; it's 20 X 20... Data 1,0,0,0,1,0,0,0,0,0,1,1,0,1,0,0,1,0,0,1 ; nothing amazing here, Data 1,0,0,0,1,0,0,1,0,0,0,1,0,1,0,1,1,1,0,1 ; play around with it. :) Data 1,0,0,0,1,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1 ; (it's the best way Data 1,0,0,1,1,0,0,1,1,1,1,1,0,1,0,1,1,1,0,1 ; to know the code works) Data 1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1 Data 1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,1 Data 1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1 ; 0 = grass Data 1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1 ; 1 = brick Data 1,0,1,1,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1 Data 1,0,1,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1 Data 1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 Restore map_data For b = 1 To 20 For a = 1 To 20 Read c r_map(a,b)=c ;<- storing our map data into its array. (r_map(x,y)) Next Next While KeyHit(1) =0 Cls ;render map ;{ For b = 1 To 20 For a = 1 To 20 If r_map(a,b)=0 Then Color 0,100,0:Rect (a-1)*20,(b-1)*20,20,20 If r_map(a,b)=1 Then Color 200,150,0:Rect (a-1)*20,(b-1)*20,20,20:Color 255,255,255:Line (a-1)*20,(b-1)*20+19,(a-1)*20+20,(b-1)*20+19:Line (a-1)*20,(b-1)*20+10,(a-1)*20+20,(b-1)*20+10:Line (a-1)*20+15,(b-1)*20+10,(a-1)*20+15,(b-1)*20+20:Line (a-1)*20,(b-1)*20,(a-1)*20,(b-1)*20+10 If e_x=a Then If e_y=b Then Color 250,150,150:Text (a-1)*20+8,(b-1)*20+8,"X" If s_x=a Then If s_y=b Then Color 150,150,200:Oval (a-1)*20+7,(b-1)*20+5,5,5:Line (a-1)*20+10,(b-1)*20+5,(a-1)*20+10,(b-1)*20+15:Line (a-1)*20,(b-1)*20+10,(a-1)*20+20,(b-1)*20+10:Line (a-1)*20,(b-1)*20+20,(a-1)*20+10,(b-1)*20+15:Line (a-1)*20+20,(b-1)*20+20,(a-1)*20+10,(b-1)*20+15 If Int(MouseX()/20)=a-1 Then If Int(MouseY()/20)=b-1 Color 200,0,0:Rect (a-1)*20,(b-1)*20,20,20,0 If MouseHit(1) Then s_x=a:s_y=b ;<- sets a starting point run_a=0 If MouseHit(2) Then e_x=a:e_y=b:run_a=1 ;<- sets a target point EndIf Next Next ;} ;render A* workings out ;{ If KeyDown(2) For b = 1 To 20 For a = 1 To 20 If a_map(a,b,1)=1 Then Color 60,60,20: Rect (a-1)*20,(b-1)*20,20,20,0 ;1 = wall If a_map(a,b,1)=2 Then Color 20,200,20: Rect (a-1)*20,(b-1)*20,20,20,0 ;2 = open If a_map(a,b,1)=3 Then Color 0,0,200: Rect (a-1)*20,(b-1)*20,20,20,0 ;3 = closed Color 255,0,0 If a_map(a,b,5)=4 Then Text (a-1)*20,(b-1)*20,"->" ;<- these are some REALLY If a_map(a,b,5)=6 Then Text (a-1)*20,(b-1)*20,"<-" ; badly put together If a_map(a,b,5)=2 Then Text (a-1)*20,(b-1)*20,"V" ; ASCII arrows.... If a_map(a,b,5)=8 Then Text (a-1)*20,(b-1)*20,"^" ; hope you can understand them :( If a_map(a,b,5)=1 Then Text (a-1)*20,(b-1)*20,"\|" If a_map(a,b,5)=3 Then Text (a-1)*20,(b-1)*20,"|/" If a_map(a,b,5)=7 Then Text (a-1)*20,(b-1)*20,"/|" If a_map(a,b,5)=9 Then Text (a-1)*20,(b-1)*20,"|\" Next Next EndIf ;} Color 255,255,255 Text 410,0,"current path:" + path$ Text 410,10,"LMB = select start point" Text 410,20,"RMB = select end point" Text 410,30,"1 = display A* workings out" Text 410,50,"ESC = quit." Color 255,255,255 Line MouseX(),MouseY(),MouseX()+10,MouseY()+15 ;<- just drawing a mouse cursor. Line MouseX(),MouseY(),MouseX()+10,MouseY()+5 Line MouseX(),MouseY(),MouseX(),MouseY()+10 Line MouseX()+10,MouseY()+5,MouseX(),MouseY()+10 Flip If run_a=1 Then ;<- if a path has just been set, ; then we run the A* pathfinder ;-------------------------------------------------------------------------------- ;Here is where the A* code starts ;-------------------------------------------------------------------------------- c_x=s_x ;<- c_x refurs to current X location for c_y=s_y ; A* pathfinder loop. when we start we ; set the current X & Y to the starting ; point (where our li'l fella is currently) ;fill in unwalkable paths ;{ For b = 1 To 20 For a = 1 To 20 a_map(a,b,1)=0 ;<- clears past tile data a_map(a,b,2)=0 ;<- clears past G cost data a_map(a,b,3)=0 ;<- clears past H cost data a_map(a,b,4)=0 ;<- clears past F cost data a_map(a,b,5)=0 ;<- clears past directional data If r_map(a,b)=1 Then a_map(a,b,1)=1 ;<- if tile at (a,b) is a wall, Next ; mark it as a "1" on the A* Next ; pathfinders array. ;} count=0 work=0 ;main loop While count < 20*20 a_map(c_x,c_y,1)=3 ;check cur_g=0 c_dir=0 lst_F=10000 n_c_x=c_x n_c_y=c_y For c_b=1 To 3 ;<- we only check tiles 1 unit For c_a=1 To 3 ; away from our current position c_dir=c_dir+1 ;<- current direction (1=upper left, 2=up ect.. ect..) chk_x=c_x+(c_a-2) chk_y=c_y+(c_b-2) If a_map(chk_x,chk_y,1)<> 1 Then If a_map(chk_x,chk_y,1)<> 3 a_map(chk_x,chk_y,1)=2 If Abs((c_a-2)+(c_b-2))>0 Then cur_g=10 If Abs((c_a-2)+(c_b-2))=2 Then cur_g=14 cur_g=cur_g+a_map(c_x,c_y,2) If a_map(chk_x,chk_y,2) > cur_g Or a_map(chk_x,chk_y,2) = 0 a_map(chk_x,chk_y,2) = cur_g ;G cost a_map(chk_x,chk_y,5) = c_dir ;Direction c_H=(Abs(chk_x-e_x)+Abs(chk_y-e_y))*10 a_map(chk_x,chk_y,3) = c_H ;H cost a_map(chk_x,chk_y,4) = a_map(chk_x,chk_y,2)+a_map(chk_x,chk_y,3) ;F cost EndIf chk_F=a_map(chk_x,chk_y,4) If chk_F < lst_F Then n_c_x=chk_x:n_c_y=chk_y:lst_F=chk_F EndIf Next Next ;finish check count=count+1 ;Ok, the next "if" statement checks if the new "current location" ;is the same as the past "current location". The only reason this ;should happen is if the current path check has got itself cornered ;and cant move anymore... this MAY mean there isn't any path, ;but more likley it just chose a silly path. To get around this ;we quickly read through the A* map data and look for a remaining "open" ;tile, then if we find one, we continue searching from that tile. ;If we run out of open tiles, there probably isn't a possible path. If n_c_x=c_x Then If n_c_y=c_y Then ;quick scan For qs_y= 1 To 20 For qs_x= 1 To 20 If a_map(qs_x,qs_y,1)=2 Then n_c_x=qs_x: n_c_y=qs_y ;<-looks for remaining "open" tile Next Next EndIf c_x=n_c_x ;<- declares the new "current location" c_y=n_c_y ;Yup, if the "current location" ever becomes the "end location" ;then we can find a logical path... awsome! =D If c_x = e_x Then If c_y = e_y Then count = 20*1000:work = 1 Wend ;main loop over ;if it works: =) If work=1 ;<- if it works, we should record the path! find=0 ; we mearly walk back using the directional c_x=e_x ; data we created. The shortest path should c_y=e_y ; get returned. path$="" While find=0 ;yeah... this is some If c_x=s_x Then If c_y = s_y Then find = 1 ;weak coding... but ;I figured a String$ If a_map(c_x,c_y,5) = 1 Then path$=path$ + "c":c_x=c_x+1:c_y=c_y+1 ;was a quick and simple If a_map(c_x,c_y,5) = 2 Then path$=path$ + "x":c_x=c_x:c_y=c_y+1 ;way of recording a If a_map(c_x,c_y,5) = 3 Then path$=path$ + "z":c_x=c_x-1:c_y=c_y+1 ;path. If a_map(c_x,c_y,5) = 4 Then path$=path$ + "d":c_x=c_x+1:c_y=c_y If a_map(c_x,c_y,5) = 6 Then path$=path$ + "a":c_x=c_x-1:c_y=c_y If a_map(c_x,c_y,5) = 7 Then path$=path$ + "e":c_x=c_x+1:c_y=c_y-1 If a_map(c_x,c_y,5) = 8 Then path$=path$ + "w":c_x=c_x:c_y=c_y-1 If a_map(c_x,c_y,5) = 9 Then path$=path$ + "q":c_x=c_x-1:c_y=c_y-1 Wend EndIf ;if the check doesn't work: =( If work=0 path$="s" ;<- I just chose "s" because it sat between "a" & "d"... nothing relivent. =P EndIf ;end main loop EndIf ;-------------------------------------------------------------------------------- ;Brilliant! more weak coding from Kev.... ;In this final chunk, we move our li'l fella ;to the end point by reading the "path$" string ;backwards... Removing a direction once we've used it. ms=MilliSecs()-oms If ms> 200 Then ;<- this just slows the li'l fella down... If path$<>"s" ; so we can watch him walk to his goal. If Len(path$)> 0 ; no real animation... but that's just fine get$=Right$(path$,1) ; if your a fan of Nethack or Rouge like If get$ = "c" Then s_x=s_x-1: s_y=s_y-1 ; myself ;) If get$ = "x" Then s_x=s_x: s_y=s_y-1 If get$ = "z" Then s_x=s_x+1: s_y=s_y-1 If get$ = "d" Then s_x=s_x-1: s_y=s_y If get$ = "a" Then s_x=s_x+1: s_y=s_y If get$ = "e" Then s_x=s_x-1: s_y=s_y+1 If get$ = "w" Then s_x=s_x: s_y=s_y+1 If get$ = "q" Then s_x=s_x+1: s_y=s_y+1 path$=Left$(path$,Len(path$)-1) ;<-removes first letter from string$ EndIf EndIf oms=MilliSecs() EndIf Wend |
Comments
| ||
Well done. At first (at first glance) I was suspicious that there may be a bit too much code here. On running it, I could see you had added stuff in like the visual path calcuation display thing. |
| ||
This is very useful stuff! I'll see if I can work some AI with this, some day... |
Code Archives Forum