;Vorbereitungen
Graphics 800,600,32,2
SetBuffer BackBuffer()

Global MapWidth%=20,MapHeight%=20
Dim MapData(MapWidth-1,MapHeight-1)
Dim Array(MapWidth-1,MapHeight-1)





Type TFeld
Field x%
Field y%
Field ch.TFeld
Field c%
Field movename$
End Type






;Mauer erstellen
MapData(7,5)=1
MapData(7,6)=1
MapData(7,7)=1

;Punkte festlegen
StartX%=2
StartY%=2
EndX%=8
EndY%=6

timer=CreateTimer(48)

;spieler = LoadImage("archer.bmp")
spieler = CreateImage(19,19)
;ziel = LoadImage("ziel.bmp")
ziel = CreateImage(19,19)
MaskImage spieler,255,0,255
MaskImage ziel,255,0,255







While Not KeyHit(1)
ams=MilliSecs()

;Funktionsaufruf
fp$=FindPath$(StartX,StartY,EndX,EndY)

ms=MilliSecs()
fps#=(1000.0/(ms-ams))*0.5+fps*0.5

;Grafische Darstellung
Cls
For y=0 To MapHeight-1
For x=0 To MapWidth-1
If MapData(x,y)=0 Then
Color 155,155,155
Rect x*20,y*20,19,19
Else
Color 255,255,255
Rect x*20,y*20,19,19
Color 55,55,55
Rect x*20+1,y*20+1,18,18
Color 88,88,88
Rect x*20+1,y*20+1,17,17
Color 55,55,55
Text x*20+5,y*20+3,"M"
EndIf
Next
Next
x=StartX
y=StartY
t$=fp
While t$<>""
nt$=Mid(t,1,1)
ax=x
ay=y
Select nt
Case 6
x=x+1
Case 2
y=y+1
Case 4
x=x-1
Case 8
y=y-1
Case 3
x=x+1
y=y+1
Case 1
x=x-1
y=y+1
Case 7
x=x-1
y=y-1
Case 9
x=x+1
y=y-1
End Select
Color 255,255,255
Rect x*20,y*20,19,19
Color 155,155,0
Line ax*20+10,ay*20+10,x*20+10,y*20+10
t=Mid(t,2)
Wend



;-----------------------------------------------------------------------------------Problem

DrawImage spieler,StartX*20,Starty*20


If KeyHit(2)
test.tfeld = First tfeld
test = After test
StartX = test\X
Starty = test\y
Text 400,400,"OK!"
End If

;-----------------------------------------------------------------------------------Problem ENDE


DrawImage ziel,endX*20,endy*20

Text 500,500,"startx: "+startx
Text 500,520,"starty: "+starty

Color 255,255,255
Text 0,220,"Weg: "+fp
t$=fps
If t="Infinity" Then
t=">1000"
fps=0
EndIf
Text 0,240,t+" FPS("+nms+"ms)"
Text 0,260,"LMT um den Startpunkt zu setzen"
Text 0,272,"RMT für den Endpunkt und MRT für Mauer;-)"
Flip 0
nms=(ms-ams)
mx=MouseX()-10
my=MouseY()-10
x=Int(mx/20.0)
y=Int(my/20.0)

;If MouseDown(1) Then
;StartX=x
;StartY=y
;EndIf

If MouseDown(2) Then
EndX=x
EndY=y
EndIf
If MouseHit(3) Then
If x<=MapWidth-1 And y<=MapHeight-1 Then
MapData(x,y)=1-MapData(x,y)
EndIf
EndIf
WaitTimer timer
Wend


End




;Funktionen & Types_________________________________________________________

Function FindPath$(StartX%,StartY%,EndX%,EndY%)



If StartX<0 Or StartY<0 Or EndX>MapWidth-1 Or EndY>MapHeight-1 Or StartX>MapWidth-1 Or StartY>MapHeight-1 Or EndX<0 Or EndY<0 Then Return ""
If MapData(StartX,StartY)>0 Or MapData(EndX,EndY)>0 Then Return ""
ClearAll()
TypeAdd EndX,EndY,Null,""
hz%=MapWidth*MapHeight
For z%=0 To hz
tw$=TypeWork$(StartX,StartY,EndX,EndY)
If tw<>"" Then Return tw
Next
Return ""
End Function

Function ClearAll()
For Feld.TFeld=Each TFeld
Delete Feld.TFeld
Next
For y=0 To MapHeight-1
For x=0 To MapWidth-1
Array(x,y)=0
Next
Next
End Function

Function TypeAdd(x%,y%,ch.TFeld,name$)
If x<0 Or y<0 Or x>MapWidth-1 Or y>MapHeight-1 Then Return
If MapData(x,y)<>0 Or Array(x,y)<>0 Then Return
Feld.TFeld=New TFeld
Feld\x=x
Feld\y=y
Feld\ch=ch
Feld\c=0
Feld\movename=name
Array(x,y)=1
Return
End Function

Function TypeWork$(sx%,sy%,zx%,zy%)
For Feld.TFeld=Each TFeld
If Feld\x=sx And Feld\y=sy Then
t$=""
Feld2.TFeld=Feld.TFeld
While Feld2.TFeld<>Null
t$=t$+Feld2\movename
Feld2.TFeld=Feld2\ch.TFeld
Wend
Return t
ElseIf Feld\c=0 Then
TypeAdd Feld\x+1,Feld\y,Feld.TFeld,4
TypeAdd Feld\x,Feld\y+1,Feld.TFeld,8
TypeAdd Feld\x-1,Feld\y,Feld.TFeld,6
TypeAdd Feld\x,Feld\y-1,Feld.TFeld,2
TypeAdd Feld\x+1,Feld\y+1,Feld.TFeld,7
TypeAdd Feld\x+1,Feld\y-1,Feld.TFeld,1
TypeAdd Feld\x-1,Feld\y+1,Feld.TFeld,9
TypeAdd Feld\x-1,Feld\y-1,Feld.TFeld,3
Feld\c=1
EndIf
Next
End Function

;-----------------------------------------------------------------------------------Problem

DrawImage spieler,StartX*20,Starty*20

For test.tfeld = Each tfeld
If KeyHit(2)
test.tfeld = First tfeld
If test\x = startx And test\y = starty Then
startx = test\x
starty = test\y
test = After test
End If

;-----------------------------------------------------------------------------------Problem ENDE
End If
Next

If KeyHit(2)
test.tfeld = First tfeld
test = After test
StartX = test\X
Starty = test\y
Text 400,400,"OK!"
End If

If KeyHit(2)
   test.tfeld = First tfeld
   StartX = test\X
   Starty = test\y
   Delete test
End If

Local num=0
   For Feld.TFeld=Each TFeld
      num=num+1
   Next
   Color(255,0,0)
   Text(10,10,"Einträge: "+num)