Graphics 640,480
SetBuffer BackBuffer()

Global sizeX,sizeY
Dim Map(0,0)
Type Zweig
 Field firstX,firstY
 Field lastX,lastY
 Field x,y
 Field further.Zweig[8]
End Type

; Map definieren
Data 1,1,1,1
Data 0,1,0,1
Data 0,1,0,1
Data 1,1,1,1
SetMapSize 4,4
For y=1 To 4
 For x=1 To 4
  Read value
  ChangeMapField(x,y,value)
 Next
Next
posx=1
posy=1
zielx=1
ziely=4



; Hier spielt sich so alles ab, was einen interessiert
Repeat
 Cls

 z.Zweig=FindWayOnMap(posx,posy,zielx,ziely)
 DrawMap posx,posy,zielx,ziely
 posx=z\firstx
 posy=z\firsty

 Delay 150
 Flip

Until KeyHit(1)
End
; Hier hört's auf interessant zu sein ^^

Function SetMapSize(x,y)
 sizeX=x+1
 sizeY=y+1
 Dim Map(x+1,y+1)
 If x*y=0 Then RuntimeError("Illegal Map-Size")
End Function
Function ChangeMapField(x,y,value)
 Map(x,y)=value
End Function
Function DrawMap(x1,y1,x2,y2)
 For x=1 To sizeX-1
  For y=1 To sizeY-1
   Select Map(x,y)
   Case 0 Color 100,0,0
   Case 1 Color 255,128,0
   End Select
   Rect x*32,y*32,32,32
  Next
 Next
 Color 0,100,0
 Oval x1*32,y1*32,32,32
 Color 0,0,100
 Oval x2*32,y2*32,32,32
End Function
Function FindWayOnMap.Zweig(x1,y1,x2,y2)
 For z.Zweig=Each Zweig
  Delete z
 Next
 If x1*x2*y1*y2=0 Or x1>sizeX Or y1>sizeY Or x2>sizeX Or y2>sizeX Then RuntimeError("Illegal Pathfind-Coordinats")
 CheckDirection x1,y1,-1,0
 CheckDirection x1,y1,-1,-1
 CheckDirection x1,y1,0,-1
 CheckDirection x1,y1,1,-1
 CheckDirection x1,y1,1,0
 CheckDirection x1,y1,1,1
 CheckDirection x1,y1,0,1
 CheckDirection x1,y1,-1,1
 For z.Zweig=Each Zweig
  Color 0,255,0
  Line z\x*32+16,z\y*32+16,z\lastx*32+16,z\lasty*32+16
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x-1,z\y)
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x-1,z\y-1)
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x,z\y-1)
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x+1,z\y-1)
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x+1,z\y)
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x+1,z\y+1)
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x,z\y+1)
  CheckDirection2(z\firstx,z\firsty,z\x,z\y,z\x-1,z\y+1)
  If z\x=x2 And z\y=y2 Then Return z
  Delete z
 Next
End Function
Function CheckDirection(x,y,xd,yd,lx=0,ly=0)
 If Map(x+xd,y+yd)<>0 Then NewZweig(x+xd,y+yd,x,y,lx,ly)
End Function
Function CheckDirection2(fx,fy,lx,ly,x,y)
 For zw.Zweig=Each Zweig
  If zw\x=x And zw\y=y Then Return 0
 Next
 If Map(x,y)<>0 Then NewZweig(fx,fy,lx,ly,x,y)
 Return 1
End Function
Function NewZweig(fx,fy,lx,ly,x=0,y=0)
  If x=0 Then x=fx
  If y=0 Then y=fy
  z.Zweig=New Zweig
  z\firstx=fx
  z\firsty=fy
  z\lastx=lx
  z\lasty=ly
  z\x=x
  z\y=y
End Function

 z.Zweig=FindWayOnMap(posx,posy,zielx,ziely)
 posx=z\firstx
 posy=z\firsty