Mit dem folgenden Snippet kann man selbst eine Map zeichnen und sich dann den Dijkstra-Pfad anzeigen lassen.
Man sollte darauf achten, möglichst zusammenhängende Mauern ohne diagonale "Schlupflöcher" zu zeichnen, dann ist das Ergebnis eindrucksvoller!
Linke Maustaste = Mauern setzen
Rechte Maustaste = Mauern löschen
Mittlere Maustaste = Start und Endpunkt setzen (sind identische Punkte, der weiter rechts unten liegende Punkt ist immer der Startpunkt)
ESC = Programm beenden
Wenn man zufrieden mit seiner Map ist, einfach "ENTER" drücken, und das Programm zeigt den berechneten Dijkstra-Pfad.
Und so funktionierts:
Einfach alle Felder der virtuellen Map auf eine hohe Zahl (z.B. 1000) setzen, das Zielfeld bleibt auf 0. Dann durch alle Felder iterieren, für jedes Feld auf den angrenzenden Nachbarfeldern schauen (Mauern und andere blockierende Architektur überspringen), ob dessen Wert um mindestens 2 kleiner ist, als der Wert des aktuellen Feldes. Wenn ja, dann den Wert des aktuellen Feldes auf [angrenzender Wert+1] setzen. Dies in einer Schleife wiederholen, solange bis nichts geändert wurde. Das Ergebnis ist eine
Heightmap, wo man vom Startpunkt aus bis zum Ziel "herunterrollt".
Code: Alles auswählen
EnableExplicit
Declare loop()
Declare createMap()
Declare processInput()
Declare calculateDijkstra()
Declare drawMap(dijkstraReady)
#xRes = 800
#yRes = 600
#xMax = 19
#yMax = 14
#tileSize = 40
Global screen
Global Dim worldMap(#xMax,#yMax)
Global Dim dijkstraMap(#xMax,#yMax)
If InitSprite()
screen = OpenWindow(#PB_Any,0,0,#xRes,#yRes,"Dijkstra Maps - (press ESC to quit)",#PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(screen),0,0,#xRes,#yRes)
If InitKeyboard()
If InitMouse()
createMap()
loop()
End
EndIf
EndIf
EndIf
EndIf
Debug "Something is rotten in the state of Denmark."
Procedure loop()
Protected dijkstraReady
Repeat
ExamineKeyboard()
ExamineMouse()
If Not dijkstraReady
dijkstraReady = processInput()
EndIf
drawMap(dijkstraReady)
FlipBuffers()
WaitWindowEvent(1)
Until KeyboardPushed(#PB_Key_Escape)
EndProcedure
Procedure createMap()
Protected x, y
For x = 0 To #xMax
For y = 0 To #yMax
If Not(x = 0 Or y = 0 Or x = #xMax Or y = #yMax)
worldMap(x,y) = 1
EndIf
Next
Next
EndProcedure
Procedure processInput()
Protected button, x, y
Dim mousehit(3)
mouseHit(1) = MouseButton(#PB_MouseButton_Left)
mouseHit(2) = MouseButton(#PB_MouseButton_Right)
mouseHit(3) = MouseButton(#PB_MouseButton_Middle)
Static count
x = MouseX()/#tileSize
y = MouseY()/#tileSize
If x = 0 Or y = 0 Or x =#xMax Or y = #yMax
ProcedureReturn 0
EndIf
For button = 1 To 2
If mouseHit(button)
If worldMap(x,y) = 2 And count > 0
count -1
EndIf
worldMap(x,y) = (button-1) ;linke Maustaste malt Mauern, rechte Maustaste löscht diese wieder
EndIf
Next
If mousehit(3) And count < 2 And worldMap(x,y) <> 2 ;Start/Endpunkte setzen (maximal 2 erlaubt)
count +1
worldMap(x,y) = 2
EndIf
If KeyboardReleased(#PB_Key_Return)
If count < 2
Debug "Start/Target-Point is missing!"
ProcedureReturn 0
Else
calculateDijkstra()
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure calculateDijkstra()
Protected x, y
Protected xDir, yDir
Protected noChange
Protected count
For x = 1 To #xMax-1
For y = 1 To #yMax-1
If worldMap(x,y) = 1
dijkstraMap(x,y) = 1000 ;irgendein hoher Wert
EndIf
If worldMap(x,y) = 2
count +1
If count = 2 ;den zweiten Punkt als Startpunkt deklarieren
dijkstraMap(x,y) = 1000
EndIf
EndIf
Next
Next
Repeat
noChange = 1
For x = 1 To #xMax-1
For y = 1 To #yMax-1
If worldMap(x,y) = 1
For xDir = -1 To 1
For yDir = -1 To 1
If dijkstraMap(x+xDir,y+yDir) < (dijkstraMap(x,y) -1) And worldMap(x+xDir,y+yDir) > 0 ;wenn angrenzender Wert um mindestens 2 kleiner ...
dijkstraMap(x,y) = dijkstraMap(x+xDir,y+yDir) +1 ;... aktuelles Feld auf [angrenzender Wert+1] setzen
noChange = 0
EndIf
Next
Next
EndIf
Next
Next
Until noChange
EndProcedure
Procedure drawMap(dijkstraReady)
Protected x, y
ClearScreen(RGB(255,255,255))
If StartDrawing(ScreenOutput())
DrawingMode(#PB_2DDrawing_Default)
For x = 0 To #xMax
For y = 0 To #yMax
Select worldMap(x,y)
Case 0
Box(x*#tileSize,y*#tileSize,#tileSize,#tileSize,RGB(0,0,0))
Case 1
If dijkstraReady
DrawText((x*#tileSize)+(#tileSize/2),(y*#tileSize)+(#tileSize/2),Str(dijkstraMap(x,y)),RGB(0,0,0),RGB(255,255,255))
EndIf
Case 2
Box(x*#tileSize,y*#tileSize,#tileSize,#tileSize,RGB(0,255,0))
EndSelect
Next
Next
Circle(MouseX(),MouseY(),5,RGB(255,0,0))
StopDrawing()
EndIf
EndProcedure
