spieleprogrammierer.de - Forum und Wiki zur Spieleprogrammierung und Spieleentwicklung

Quellcode

''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