Code
Astar()
While Not KeyDown(1)
Flip
Wend
Function Astar()
zakrito(xob,yob)=2
While Not Target=1
For i=-1 To 1
For e=-1 To 1
If zakrito(xob,yob)=2 And zakrito(xob+i,yob+e)<>1 And zakrito(xob+i,yob+e)<>2
zakrito(xob+i,yob+e)=2
v=v+1
OpenX(v)=xob+i
OpenY(v)=yob+e
If i<>0 And e<>0 Then
k#=1.2
Else
k#=1
EndIf
shagi#(xob+i,yob+e)=shagi(xob,yob)+k#
Dist=Sqr((xob+i-xcel)^2+(yob+e-ycel) ^2)
distancia(xob+i,yob+e)=dist+shagi(xob+i,yob+e)
dorogaX(xob+i,yob+e)=xob
dorogaY(xob+i,yob+e)=yob
If Dist<2 Then
Target=1
xob=xob+i
yob=yob+i
Goto Astarstop
EndIf
EndIf
Next
Next
zakrito(xob,yob)=1
min = 90000
fuck=v
For r=1 To fuck
d=OpenX(r)
f=OpenY(r)
If distancia(d,f)=<min Then
min=distancia(d,f)
vmin=r
xob=d
yob=f
EndIf
Next
OpenX(vmin)=OpenX(v)
OpenY(vmin)=OpenY(v)
v=v-1
I f min=90000 Then Goto netputi
Wend
.Astarstop
celx=xob
cely=yob
While Not Star=1
setka$=celx+":"+cely+"|"+setka$
faktorx= dorogaX(celx,cely)
faktory= dorogaY(celx,cely)
celx=faktorx
cely=faktory
If celx=xstart And cely=ystart Then
Star=1
EndIf
Wend
.netputi
End Function
В некоторых случаях что то несклеивается и программа зависает