;Die Routine ist teilweise vom Pathfinding Tutorial auf www.blitzbase.de
;abgeguckt.
;Dabei wird zum Finden des Ziels ein Pin durch die Karte geschickt, der
;alle Plätze, an denen er schon war mit Zahlen vollstopft, und so nicht
;einen Platz zweimal betreten kann. Mauert er sich mit Zahlen ein, muss das
;Zahlenmuster wieder gelöscht werden.
;Anders als im Tutorial kommt die Routine ohne Ursprungsknotenliste und ohne
;To-DO-Liste aus. Es wird jeweils immer nur ein Punkt behandelt und was als
;nächstes zu tun ist, ergibt sich aus der Umgebung.

AppTitle "Wegsuching"
Graphics 640,480,16,2
SetBuffer BackBuffer()

Const breit = 12
Const hoch = 9

Global num,nnum,akx,aky,startx,starty,zielx,ziely,found

;Karte einlesen
Dim map(breit,hoch)
For i = 0 To hoch
For j = 0 To breit
Read map(j,i)

If map(j,i) = 2 Then
startx = j
starty = i
EndIf
If map(j,i) = 3 Then
zielx = j
ziely = i
EndIf

Next
Next
Data 1,1,1,1,1,1,1,1,1,1,1,1,1
Data 1,0,2,0,1,0,0,0,1,0,0,0,1
Data 1,0,0,0,1,0,0,0,0,0,0,0,1
Data 1,0,0,0,1,0,0,1,1,0,0,0,1
Data 1,0,1,1,1,0,0,0,1,0,0,0,1
Data 1,0,0,0,1,0,0,0,1,0,0,0,1
Data 1,0,0,0,1,1,0,0,1,0,0,0,1
Data 1,0,0,0,0,0,0,0,1,0,3,0,1
Data 1,0,0,0,1,0,0,0,1,0,0,0,1
Data 1,1,1,1,1,1,1,1,1,1,1,1,1

;Feld zum Speichern des Pfads
Const emax = 245
Dim eckpunkt(emax,3)

;Feld für das Zahlenmuster
Dim device(breit,hoch)
For i = 0 To hoch
For j = 0 To breit
device(j,i) = 0
Next
Next

;Feld für alle Kanditaten
Const nmax = 50
Dim nominee(nmax,3)
nnum = 0

num = 1

;Funktion überprüft, ob es einen Ausweg gibt (nicht so wichtig)
Function umzingelt()
umz = 0
If device(akx+1,aky)<>0 Or map(akx+1,aky)=1 Then
If device(akx-1,aky)<>0 Or map(akx-1,aky)=1 Then
If device(akx,aky+1)<>0 Or map(akx,aky+1)=1 Then
If device(akx,aky-1)<>0 Or map(akx,aky-1)=1 Then
umz = 1
EndIf
EndIf
EndIf
EndIf

Return umz

End Function

;Funktion löscht Kandidaten
Function clear_nominees()
nnum = 0
For i = 0 To nmax
nominee(i,1)=0
nominee(i,2)=0
nominee(i,3)=200
Next
End Function

;Funktion löscht Muster
Function clear_device()
For i = 0 To hoch
For j = 0 To breit
device(j,i)=0
Next
Next
device(akx,aky)=1
End Function

;!!!Es geht los!!!

;Pin auf Anfangspunkt stellen und die Koordinaten in Pfad-Feld speichern
akx = startx
aky = starty
device(akx,aky)=1
eckpunkt(num,1)=akx
eckpunkt(num,2)=aky
eckpunkt(num,3)=1
num = num + 1

Repeat

;-----------

;If umzingelt = 1 Then clear_device()

;alle Punkte oberhalb, unterhalb, links und rechts vom pin erfassen:
;Wenn sich nicht in einer Wand liegen oder bereits beschriftet sind,
;werden sie im Muster-Feld mit dem aktuellen Zahlenwert beschriftet
If aky<=hoch-1 Then
If device(akx,aky+1)=0 And map(akx,aky+1)<>1 Then
If aky+1<=hoch Then
device(akx,aky+1)=device(akx,aky)+1
EndIf
EndIf
EndIf

If aky>=1 Then
If device(akx,aky-1)=0 And map(akx,aky-1)<>1 Then
If aky-1>=0 Then
device(akx,aky-1)=device(akx,aky)+1
EndIf
EndIf
EndIf

If akx<=breit-1 Then
If device(akx+1,aky)=0 And map(akx+1,aky)<>1 Then
If akx+1<=breit Then
device(akx+1,aky)=device(akx,aky)+1
EndIf
EndIf
EndIf

If akx>=1 Then
If device(akx-1,aky)=0 And map(akx-1,aky)<>1 Then
If akx-1>=0 Then
device(akx-1,aky)=device(akx,aky)+1
EndIf
EndIf
EndIf

;Als nächstes muss geprüft werden, welcher der max vier erfassten Punkte
;dem potentiell kürzesten weg zum Ziel hat. Dazu werden diese Punkte in die
;in die Kandidatenliste aufgenommen und anschließend wird geprüft.

clear_nominees()

For i = 0 To hoch
For j = 0 To breit
If device(j,i)=device(akx,aky)+1 Then
nominee(nnum,1)=j
nominee(nnum,2)=i
nominee(nnum,3)=Abs(zielx-j)+Abs(ziely-i)
nnum = nnum + 1
EndIf
Next
Next

winner = 0
best = 200000
found = 0
For i = 0 To nnum-1
If nominee(i,3)<best Then
winner = i
best = nominee(i,3)
found = 1
EndIf
Next
If found = 0 Then
clear_device()
Else
akx = nominee(winner,1)
aky = nominee(winner,2)
EndIf

;Der Pin wurde versetzt und die Koordinaten des Pins wurden ins Pfad-Feld
;aufgenommen
eckpunkt(num,1)=akx
eckpunkt(num,2)=aky
eckpunkt(num,3)=1
num = num + 1

;------Draw-------

For i = 0 To hoch
For j = 0 To breit
Text j*20+10,i*15+100,map(j,i),1,1
Next
Next

For i = 0 To hoch
For j = 0 To breit
Select map(j,i)
Case 0
Color 80,80,80
Case 1
Color 0,255,255
Case 2
Color 0,255,0
Case 3
Color 0,0,255
End Select
Rect j*20+320-10,i*15+100-8,20,15
Color 255,255,255
Text j*20+320,i*15+100,device(j,i),1,1
Next
Next

Color 255,0,255
For i = 1 To emax
If eckpunkt(i,3)=1 Then
Oval eckpunkt(i,1)*20+320-1,eckpunkt(i,2)*15+100-1,3,3
If eckpunkt(i+1,3)=1 Then
Line eckpunkt(i,1)*20+320,eckpunkt(i,2)*15+100,eckpunkt(i+1,1)*20+320,eckpunkt(i+1,2)*15+100
EndIf
EndIf
Next

Color 255,0,0
Oval akx*20+320-3,aky*15+100-3,7,7
Color 255,255,255

Text 0,0,"weiter mit beliebiger Taste"

If num>=emax Then RuntimeError("Puffer voll!")

Flip
WaitKey
Cls
Until KeyHit(1) Or (akx = zielx And aky = ziely)
End

Data 1,1,1,1,1,1,1,1,1,1,1,1,1
Data 1,0,2,0,1,0,1,0,1,0,0,3,1
Data 1,0,0,0,0,0,1,0,0,0,1,0,1
Data 1,0,0,0,1,0,1,1,1,0,0,0,1
Data 1,1,1,1,1,0,0,0,1,0,0,1,1
Data 1,0,0,0,1,0,0,0,1,0,0,0,1
Data 1,0,0,0,1,1,0,0,1,1,0,0,1
Data 1,0,0,0,0,0,0,0,1,0,0,0,1
Data 1,0,0,0,1,0,0,0,0,0,0,0,1
Data 1,1,1,1,1,1,1,1,1,1,1,1,1