Code:
Option Explicit
' Nachfolgende Routinen dienen zum Auffinden von Möglichen Positionen eines Roboters innerhalb einer
' Karte.
' Die Karte muss zunächst "gefüllt" werden. Diese Routinen fehlen hier.
' EchteKarte
' Enthält 80x80 Bits, eine eins (1) signalisiert "Hinderniss", eine Null (0) "frei"
' Benötigt demnach 80x80Bits=6400 Bits = 800 Bytes
Public EchteKarte(0 To 79, 0 To 79) As Boolean ' in Visual Basic gibt es den Datentyp Bit nicht, deshalb Boolean!
' MoeglichePositionen
' Nachfolgend ein Array welches global zur Verfügung steht und dem Hauptprogramm
' mitteilen kann wo sich der Roboter befinden könnte. Maximal werden hier 10 (0-9)
' mögliche Positionen gespeichert. Die Anzahl der gefundenen Positionen sind
' in der Variablen MoeglichePositionen gespeichert. Die Koordinaten (0-79) entsprechend
' dem Array MoeglichePosition_X und MoeglichePosition_Y.
Public Const ZuErmittelndePositionen = 10
Public MoeglichePosition_X(0 To ZuErmittelndePositionen - 1) As Integer ' Erstes Element in Index 0!!
Public MoeglichePosition_Y(0 To ZuErmittelndePositionen - 1) As Integer ' Erstes Element in Index 0!!
Public MoeglichePositionen As Integer
' VirtuelleKarte
' Da einige Koordinaten außerhalb der echten Karte liegen können, d.h. X und Y sind
' ungültig, liefert diese Funktion, sofern X und Y korrekt sind, den echten Wert
' aus der Karte zurück. Andernfalls den Wert der Variable "WertAusserhalb".
Private Function VirtuelleKarte(ByVal X As Integer, ByVal Y As Integer, ByVal WertAusserhalb As Boolean) As Boolean
' Befinden sich die Koordinaten noch innerhalb der EchteKarte?
If X >= 0 And X <= 79 And Y >= 0 And Y <= 79 Then
' Wenn ja, echten Karteninhalt zurück liefern
VirtuelleKarte = EchteKarte(X, Y)
Else
' Außerhalb der EchteKarte: Hinderniss melden
VirtuelleKarte = WertAusserhalb
End If
End Function
' PruefeHimmelsrichtung
' Prüft bzw. ermittelt bis zu 10 mögliche Positionen an denen sich der Roboter befinden kann.
' Als Parameter sind die Abstände zum ersten
Private Function PruefeHimmelsrichtung(ByVal MoeglicheKoordinate_X As Integer, ByVal MoeglicheKoordinate_Y As Integer, ByVal Abstand As Integer, ByVal FaktorXRichtung As Integer, ByVal FaktorYRichtung As Integer) As Boolean
Dim AktuellerAbstand As Integer
If Abstand = 0 Then
' in dieser Himmelsrichtung darf es kein Hinderniss geben!
For AktuellerAbstand = 0 To 79
If VirtuelleKarte(MoeglicheKoordinate_X + (AktuellerAbstand * FaktorXRichtung), MoeglicheKoordinate_Y + (AktuellerAbstand * FaktorYRichtung), False) = True Then
' Doch ein Hinderniss dazwischen, Abbruch:
PruefeHimmelsrichtung = False
Exit Function
End If
Next AktuellerAbstand
Else
' In dieser Himmelsrichtung muss es ein Hinderniss geben!
' Von MoeglicheKoordinate_X,MoeglicheKoordinate_Y aus in die geforderte Richtung und Abstand darf kein Hinderniss sein:
For AktuellerAbstand = 0 To Abstand
If VirtuelleKarte(MoeglicheKoordinate_X + (AktuellerAbstand * FaktorXRichtung), MoeglicheKoordinate_Y + (AktuellerAbstand * FaktorYRichtung), True) = True Then
' Doch ein Hinderniss dazwischen, Abbruch:
PruefeHimmelsrichtung = False
Exit Function
End If
Next AktuellerAbstand
' Am Ende muss jedoch das geforderte Hinderniss sein, prüfen:
If VirtuelleKarte(MoeglicheKoordinate_X + ((Abstand + 1) * FaktorXRichtung), MoeglicheKoordinate_Y + ((Abstand + 1) * FaktorYRichtung), False) = False Then
' doch kein Hinderniss da, also nicht geeignet:
PruefeHimmelsrichtung = False
Exit Function
End If
End If
' Alle Bedingungen für diese Himmelsrichtung vorhanden:
PruefeHimmelsrichtung = True
End Function
' SucheKartenPosition
' ~~~~~~~~~~~~~~~~~~~
' Sucht anhand von vier gegebenen Hindernissabständen in alle vier Himmelsrichtungen (N,S,O,W) in der Karte
' nach maximal 10 möglichen Positionen an der sich der Roboter aufhalten könnte.
' In Abstand_Nord, Abstand_Sued, Abstand_Ost und Abstand_West sind die Abstände der betroffenen Himmelsrichtung bis zum ersten Hinderniss
' anzugeben.
Public Sub SucheKartenPosition(ByVal Abstand_Nord As Integer, ByVal Abstand_Sued As Integer, ByVal Abstand_Ost As Integer, ByVal Abstand_West As Integer)
Dim AkX As Integer
Dim AkY As Integer
Dim MoeglicheKoordinate_X As Integer
Dim MoeglicheKoordinate_Y As Integer
Dim ErfuellteBedingungen As Integer
' Bisher konnten noch keine Position ermittelt werden:
MoeglichePositionen = 0
' Für jeden Punkt in der EchteKarte:
For AkX = 0 To 79
For AkY = 0 To 79
' Befindet sich an dieser Position ein Hinderniss in der EchteKarte?
If EchteKarte(AkX, AkY) = True Then
' Den möglichen Mittelpunkt von Norden aus berechnen
MoeglicheKoordinate_X = AkX
MoeglicheKoordinate_Y = AkY + Abstand_Nord + 1
' bisher noch keine Bedingung erfüllt:
ErfuellteBedingungen = 0
' Bedingung nach N prüfen:
If PruefeHimmelsrichtung(MoeglicheKoordinate_X, MoeglicheKoordinate_Y, Abstand_Nord, 0, -1) = True Then
ErfuellteBedingungen = ErfuellteBedingungen + 1
End If
' Bedingung nach S prüfen:
If PruefeHimmelsrichtung(MoeglicheKoordinate_X, MoeglicheKoordinate_Y, Abstand_Sued, 0, 1) = True Then
ErfuellteBedingungen = ErfuellteBedingungen + 1
End If
' Bedingung nach O prüfen:
If PruefeHimmelsrichtung(MoeglicheKoordinate_X, MoeglicheKoordinate_Y, Abstand_Ost, -1, 0) = True Then
ErfuellteBedingungen = ErfuellteBedingungen + 1
End If
' Bedingung nach W prüfen:
If PruefeHimmelsrichtung(MoeglicheKoordinate_X, MoeglicheKoordinate_Y, Abstand_West, 1, 0) = True Then
ErfuellteBedingungen = ErfuellteBedingungen + 1
End If
' Alle notwendigen Bedingungen erfüllt?
If ErfuellteBedingungen = 4 Then
' Alle Bedingungen sind erfüllt, hier ist ein möglicher Punkt
' an Koordinate MoeglicheKoordinate_X, MoeglicheKoordinate_Y
MoeglichePosition_X(MoeglichePositionen) = MoeglicheKoordinate_X
MoeglichePosition_Y(MoeglichePositionen) = MoeglicheKoordinate_Y
MoeglichePositionen = MoeglichePositionen + 1
If MoeglichePositionen > UBound(MoeglichePosition_X) Then ' größer 9?
' Suche hier abbrechen, schon 10 mögliche Positionen gefunden!
Exit Sub
End If
End If
End If
Next AkY
Next AkX
End Sub
Mit Hilfe dieses Codes müsste es möglich sein innerhalb sehr kurzer Zeit die Position innerhalb einer Karte zu ermitteln.
Zitieren
Lesezeichen