Stilllegung des Forums
Das Forum wurde am 05.06.2023 nach über 20 Jahren stillgelegt (weitere Informationen und ein kleiner Rückblick).
Registrierungen, Anmeldungen und Postings sind nicht mehr möglich. Öffentliche Inhalte sind weiterhin zugänglich.
Das Team von spieleprogrammierer.de bedankt sich bei der Community für die vielen schönen Jahre.
Wenn du eine deutschsprachige Spieleentwickler-Community suchst, schau doch mal im Discord und auf ZFX vorbei!
Werbeanzeige
Quellcode |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 |
''Pathfind(Floodfill) Beispiel ''FreeBASIC (fbc 0.24) ''equivalent to ''Java: import java.util.LinkedList #include "LinkedList.bi" ''Globals Dim Shared as Integer ptr WorldMap ''Our Worldmap Dim Shared as Integer WorldWidth ''Out World width (XSize) Dim Shared as Integer WorldHeight ''Our World height (YSize) ''get_Path wird eine Map mit den Wegkosten zurückgeben ''Da unsere Map Global definiert ist brauchen wir nur ''die start und ziel positionen angeben Function get_PathMap(byval fromX as Integer, fromY as Integer, _ byval targetX as Integer, targetY as Integer) as Integer ptr ''equivalent to: int[][] PathMap = new int[WorldWidth][WorldHeight] Dim PathMap as Integer ptr = NEW Integer[WorldWidth*WorldHeight] ''eqivalent to: new Stack<int>() Dim stack as tList ''aktuelle Map-Position Dim mappos as Integer ''zum auflösen der Map-Position in X und Y werte Dim as Integer X, Y ''Map-Position muss aufgelöst werden mappos = fromX + (fromY * WorldWidth) ''eqivalent to: stack.push(mappos) stack.AddEntry(mappos) ''aktuelle mapposition wird für ''die weiterverarbeitung zwischengespeichert ''eqivalent to: while(!stack.isEmpty()) { While (stack.FirstEntry) 'Die schleife laeuft solange noch 'einträge zwischengespeichert sind ''eqivalent to: mappos = stack.pop() mappos = stack.FirstEntry -> EntryValue 'holt einen zwischengespeicherten eintrag stack.DelEntry(stack.FirstEntry) 'löscht den Eintrag ''eqivalent to: PathMap[mappos] += 1 'der Wert an der gespeicherten Position 'wird um 1 erhöht ''Auflösen der mappos in X und Y X = mappos mod WorldWidth : Y = mappos \ WorldWidth ''Notausgang, vorzeiiges abbrechen der Schleife wenn Ziel erreicht ''eqivalent to: if (x == xZiel && y == yZiel) { break; } If (X = targetX) and (Y = targetY) Then Exit While ''Wenn das Ziel noch nicht erreicht wurde läuft die Schleife hier weiter: If (X > 0) Then '' Wenn (X > 0) links gesucht werden kann 'Links prüfen ob WorldMap 'begehbar' ist und ob PathMap 'an der Stelle noch nicht geprüft wurde. If (WorldMap[mappos-1] = 0) and (PathMap[mappos-1] = 0) Then PathMap[mappos-1] = PathMap[mappos] 'Wert der aktuellen Zelle übergeben stack.AddEntry(mappos-1) 'Position für weitere Prüfung speichern End If End If If (Y > 0) Then '' Wenn (Y > 0) oben gesucht werden kann 'Oben prüfen ob WorldMap 'begehbar' ist und ob PathMap 'an der Stelle noch nicht geprüft wurde. If (WorldMap[mappos-WorldWidth] = 0) and (PathMap[mappos-WorldWidth] = 0) Then PathMap[mappos-WorldWidth] = PathMap[mappos] 'Wert der aktuellen Zelle übergeben stack.AddEntry(mappos-WorldWidth) 'Position für weitere Prüfung speichern End If End If If (X < (WorldWidth-1)) Then '' Wenn (X > 0) rechts gesucht werden kann 'Rechts prüfen ob WorldMap 'begehbar' ist und ob PathMap 'an der Stelle noch nicht geprüft wurde. If (WorldMap[mappos+1] = 0) and (PathMap[mappos+1] = 0) Then PathMap[mappos+1] = PathMap[mappos] 'Wert der aktuellen Zelle übergeben stack.AddEntry(mappos+1) 'Position für weitere Prüfung speichern End If End If If (Y < (WorldHeight-1)) Then '' Wenn (X > 0) unten gesucht werden kann 'Unten prüfen ob WorldMap 'begehbar' ist und ob PathMap 'an der Stelle noch nicht geprüft wurde. If (WorldMap[mappos+WorldWidth] = 0) and (PathMap[mappos+WorldWidth] = 0) Then PathMap[mappos+WorldWidth] = PathMap[mappos] 'Wert der aktuellen Zelle übergeben stack.AddEntry(mappos+WorldWidth) 'Position für weitere Prüfung speichern End If End If Wend return PathMap End Function ''Nur zur visuellen Darstellung Sub drawWorld() Dim WorldColor as UInteger For y as Integer = 0 to WorldHeight-1 For x as Integer = 0 to WorldWidth-1 Select Case WorldMap[x+(y*WorldWidth)] Case 0 WorldColor = &h000000 Case Else WorldColor = &hFF0000 End Select Line(x*20,y*20)-(19+(x*20),19+(y*20)),WorldColor,bf next x next y End Sub Sub drawPath(byval fromX as Integer, fromY as Integer, _ byval targetX as Integer, targetY as Integer) Dim PathMap as Integer ptr 'Path auflösen PathMap = get_PathMap(fromX,fromY,targetX,targetY) Dim WegWert as Integer Dim WegX as Integer = targetX Dim WegY as Integer = targetY Dim mappos as Integer = WegX + (WegY * WorldWidth) WegWert = PathMap[mappos] Do While WegWert ''Solage nach den Weg suchen bis wir am Start sind 'Weg hervorheben Line (WegX*20,WegY*20)-(19+(WegX*20),19+(WegY*20)),&hFF8800,B Draw String (2+WegX*20,2+WegY*20),str(WegWert),&hFF8800 'Weg entfernen PathMap[mappos] = 0 If (WegX > 0) Then If (PathMap[mappos-1] = (WegWert -1)) Then WegX -= 1 : mappos -= 1 : WegWert -= 1 continue do 'schleife von vorne beginnen End If End If If (WegY > 0) Then If (PathMap[mappos-WorldWidth] = (WegWert -1)) Then WegY -= 1 : mappos -= WorldWidth : WegWert -= 1 continue do 'schleife von vorne beginnen End If End If If (WegX < (WorldWidth-1)) Then If (PathMap[mappos+1] = (WegWert -1)) Then WegX += 1 : mappos += 1 : WegWert -= 1 continue do 'schleife von vorne beginnen End If End If If (WegY < (WorldHeight-1)) Then If (PathMap[mappos+WorldWidth] = (WegWert -1)) Then WegY += 1 : mappos += WorldWidth : WegWert -= 1 continue do 'schleife von vorne beginnen End If End If Loop 'restliche PathMap 'zeichnen' For y as Integer = 0 to WorldHeight-1 For x as Integer = 0 to WorldWidth-1 Line (x*20,y*20)-(19+(x*20),19+(y*20)),&h666666,B If PathMap[x + (y * WorldWidth)] Then Draw String (2+x*20,2+y*20),str(PathMap[x + (y * WorldWidth)]),&h666666 End If Next x Next y Delete[] PathMap End Sub 'Main Screenres 800,600,32 Randomize Timer WorldWidth = 40 WorldHeight = 30 WorldMap = NEW Integer[WorldWidth*WorldHeight] Dim as Integer MX,MY,MB Dim as Integer mapX,mapY Dim as integer playerx,playery 'zufällige hindernisse For h as integer = 0 to 99 WorldMap[rnd*(WorldWidth*WorldHeight)] = 1 Next h playerx = rnd*WorldWidth playery = rnd*WorldHeight Do If Multikey(&h01) Then Exit Do 'ESC zum Beenden getMouse MX,MY,,MB mapX = MX \ 20'WorldWidth mapY = MY \ 20'WorldHeight screenlock drawWorld() Line (1+playerx*20,1+playery*20)-(18+(playerx*20),18+(playery*20)),&h2222EE,BF drawPath(playerx,playery,mapX,mapY) screenunlock If (MB = 1) Then playerx = mapx playery = mapy end if sleep 1 Loop Delete[] WorldMap |
Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von »EternalPain« (06.04.2013, 22:56) aus folgendem Grund: source hinzugefügt
Danke, aber wie gesagt, ich habe den Code nun als C#-Programm umgesetzt und er funktioniert. Ich weiß nicht wo der Fehler beim Java Code war, evtl. lag es wieder an der IDE, keine Ahnung...Ich glaube einfach mal das Du das Prinzip noch nicht wirklich verstanden hast, was der Code eigentlich macht bzw machen soll...
Ich weiß auch nicht wie man es Dir noch besser erklären könnte, hier wurde bereits alles erklärt, links vergeben, Codes geschrieben und bebildert....