Here is the pathfinding routine
[source = "vb"] Public Function Pathfind(ByVal destination As Point, ByVal start As Point) As Integer Dim x1, y1, x2, y2 As Integer Dim Openlist As List(Of map) = New List(Of map) Dim closedlist As List(Of map) = New List(Of map) Dim currentnode As map x1 = destination.X / 50 x2 = start.X / 50 y1 = destination.X / 50 y2 = start.X / 50 Openlist.Add(grid(x1, y1)) While Not closedlist.Contains(grid(x2, y2)) Openlist.Sort(AddressOf sortfscore) currentnode = Openlist(0) closedlist.Add(Openlist(0)) Openlist.Remove(Openlist(0)) If currentnode.x / 50 + 1 < xbound And currentnode.y / 50 < ybound And currentnode.x / 50 + 1 > -1 And currentnode.y / 50 > -1 Then If (Not closedlist.Contains(grid(currentnode.x / 50 + 1, currentnode.y / 50))) And grid(currentnode.x / 50 + 1, currentnode.y / 50).check_collision(player, wall) = 0 Then If Not Openlist.Contains(grid(currentnode.x / 50 + 1, currentnode.y / 50)) Then Openlist.Add(grid(currentnode.x / 50 + 1, currentnode.y / 50)) grid(currentnode.x / 50 + 1, currentnode.y / 50).parent = currentnode grid(currentnode.x / 50 + 1, currentnode.y / 50).Fscore = getfscore(grid(currentnode.x / 50 + 1, currentnode.y / 50), destination) Else grid(currentnode.x / 50 + 1, currentnode.y / 50).parent = currentnode grid(currentnode.x / 50 + 1, currentnode.y / 50).Fscore = getfscore(grid(currentnode.x / 50 + 1, currentnode.y / 50), destination) End If End If End If If currentnode.x / 50 - 1 < xbound And currentnode.y / 50 < ybound And currentnode.x / 50 - 1 > -1 And currentnode.y / 50 > -1 Then If (Not closedlist.Contains(grid(currentnode.x / 50 - 1, currentnode.y / 50))) And grid(currentnode.x / 50 - 1, currentnode.y / 50).check_collision(player, wall) = 0 Then If Not Openlist.Contains(grid(currentnode.x / 50 - 1, currentnode.y / 50)) Then Openlist.Add(grid(currentnode.x / 50 - 1, currentnode.y / 50)) grid(currentnode.x / 50 - 1, currentnode.y / 50).parent = currentnode grid(currentnode.x / 50 - 1, currentnode.y / 50).Fscore = getfscore(grid(currentnode.x / 50 - 1, currentnode.y / 50), destination) Else grid(currentnode.x / 50 - 1, currentnode.y / 50).parent = currentnode grid(currentnode.x / 50 - 1, currentnode.y / 50).Fscore = getfscore(grid(currentnode.x / 50 - 1, currentnode.y / 50), destination) End If End If End If If currentnode.x / 50 < xbound And currentnode.y / 50 + 1 < ybound And currentnode.x / 50 > -1 And currentnode.y / 50 + 1 > -1 Then If (Not closedlist.Contains(grid(currentnode.x / 50, currentnode.y / 50 + 1))) And grid(currentnode.x / 50, currentnode.y / 50 + 1).check_collision(player, wall) = 0 Then If Not Openlist.Contains(grid(currentnode.x / 50, currentnode.y / 50 + 1)) Then Openlist.Add(grid(currentnode.x / 50, currentnode.y / 50 + 1)) grid(currentnode.x / 50, currentnode.y / 50 + 1).parent = currentnode grid(currentnode.x / 50, currentnode.y / 50 + 1).Fscore = getfscore(grid(currentnode.x / 50, currentnode.y / 50 + 1), destination) Else grid(currentnode.x / 50, currentnode.y / 50 + 1).parent = currentnode grid(currentnode.x / 50, currentnode.y / 50 + 1).Fscore = getfscore(grid(currentnode.x / 50, currentnode.y / 50 + 1), destination) End If End If End If If currentnode.x / 50 < xbound And currentnode.y / 50 - 1 < ybound And currentnode.x / 50 > -1 And currentnode.y / 50 - 1 > -1 Then If (Not closedlist.Contains(grid(currentnode.x / 50, currentnode.y / 50 - 1))) And grid(currentnode.x / 50, currentnode.y / 50 - 1).check_collision(player, wall) = 0 Then If Not Openlist.Contains(grid(currentnode.x / 50, currentnode.y / 50 - 1)) Then Openlist.Add(grid(currentnode.x / 50, currentnode.y / 50 - 1)) grid(currentnode.x / 50, currentnode.y / 50 - 1).parent = currentnode grid(currentnode.x / 50, currentnode.y / 50 - 1).Fscore = getfscore(grid(currentnode.x / 50, currentnode.y / 50 - 1), destination) Else grid(currentnode.x / 50, currentnode.y / 50 - 1).parent = currentnode grid(currentnode.x / 50, currentnode.y / 50 - 1).Fscore = getfscore(grid(currentnode.x / 50, currentnode.y / 50 - 1), destination) End If End If End If End While End FunctionThis is the "map" class which defines the nodes being used in the lists:
[source = "vb"]Public Class map Public x As Integer Public y As Integer Public Fscore As Integer Public topleft As Point Public parent As map Public bottomright As Point Public Sub New(ByVal x1, ByVal y1, ByVal counter1) x = x1 y = y1 Fscore = counter1 topleft = New Point(x, y) bottomright = topleft End Sub Public Function check_collision(ByVal entities As Entity, ByVal walll() As barrier) As Integer For z = 0 To 4 If walll(z).bottomright.Y < topleft.Y Then check_collision = 0 'Form1.TextBox2.Text = "true" ElseIf bottomright.Y < walll(z).topleft.Y Then check_collision = 0 'Form1.TextBox4.Text = "true" ElseIf walll(z).bottomright.X < topleft.X Then check_collision = 0 'Form1.TextBox3.Text = "true" ElseIf bottomright.X < walll(z).topleft.X Then check_collision = 0 'Form1.TextBox5.Text = "True" Else check_collision = 1 z = 5 End If Next End Function End ClassAnd finally this is what returns the fscore of each node:
[source = "vb"]Public Function getfscore(ByVal node As map, ByVal destination As Point) As Integer Dim x1, y1, x2, y2, sumx, sumy As Integer x1 = destination.X / 50 y1 = destination.Y / 50 x2 = node.x / 50 y2 = node.x / 50 sumx = x1 - x2 If sumx < 0 Then sumx = -sumx End If sumy = y1 - y2 If sumy < 0 Then sumy = -sumy End If getfscore = sumy + sumx End FunctionThe problem is i get an out of range exception when trying to set currentnode to the first indexed member of openlist. I'm not sure at how many iterations this happens, but the very fact that the list isn't being populated leads me to believe there is a serious flaw, else the algorithm wouldn't have gotten itself to a point where no nodes would be added. Thanks for the help!
[Edited by - Dandz on July 12, 2010 4:29:19 PM]
