My own try at A*

[Torahteen]

Ok, Well... I redid the entire thing. I compiled and ran this code:

[syntax="qbasic"]
DefInt A-Z
'$Dynamic
Declare Sub ClearScreen()
Declare Sub DrawScreen()

Declare Sub FindPath()
Declare Sub AddToOpen(x As Integer, y As Integer)
Declare Sub AddToClosed(x As Integer, y As Integer)
Declare Sub AddToPath(x As Integer, y As Integer)
Declare Function IsOnOpen(x As Integer, y As Integer)
Declare Function IsOnClosed(x As Integer, y As Integer)

const Ground = 0
const Hill = 1
const Water = 3
const Wall = 4
const Start = 5
const Finish = 6

const False = 0
const True = Not False

const GroundCost = 10
const HillCost = 25
const WaterCost = 50

Type SquareType
fScore As Integer
gScore As Integer
hScore As Integer
mType As Integer
pX As Integer
pY As Integer
End Type

Type PointType
x As Integer
y As Integer
End Type

Open "board.brd" For Input As #1
Input #1, sWidth, sHeight

Dim Shared Map(sWidth, sHeight) As SquareType
Dim Shared OpenList() As PointType
Dim Shared ClosedList() As PointType
Dim Shared Path() As PointType
Dim Shared mStart As PointType
Dim Shared mFinish As PointType
Dim Shared comp As PointType

For y = 1 To sHeight
For x = 1 To sWidth
Input #1, Map(x,y).mType
If Map(x,y).mType = Finish Then
mFinish.x = x
mFinish.y = y
ElseIf Map(x,y).mType = Start Then
mStart.x = x
mStart.y = y
End If
Next x
Next y
Close #1

Print "Finding Path"

FindPath

Print "Path Found"
Screen 18
For i = uBound(Path) To 1 Step -1
ClearScreen

comp.x = Path(i).x
comp.y = Path(i).y

DrawScreen

Do While Inkey$ = ""
Loop

Next i
Sleep
End

Sub FindPath()
'A* pathfinding Algorithm
Dim c As PointType 'Current Square
Dim onFinish As Integer

c.x = mStart.x 'Set the current square to
c.y = mStart.y 'the start square coord.

Do While onFinish = False 'Do this while we have not found the Finish square
AddToClosed c.x, c.y 'Add the current square to the Closed list
For y = -1 to 1
For x = -1 to 1
If Not Map((c.x + x),(c.y+y)).mType = Wall Then 'If it is not a Wall square
If (IsOnClosed((c.x + x),(c.y + y))) = False Then 'If it is not on the Closed List
If (IsOnOpen((c.x + x),(c.y + y))) = False Then 'It is not on the Open list, add it

'Calculate F, G, and H scores
'G First
If Map((c.x + x),(c.y + y)).mType = Ground Then
Map((c.x + x),(c.y + y)).gScore = Map((c.x),(c.y)).gScore + GroundCost
ElseIF Map((c.x + x),(c.y + y)).mType = Hill Then
Map((c.x + x),(c.y + y)).gScore = Map((c.x),(c.y)).gScore + HillCost
ElseIf Map((c.x + x),(c.y + y)).mType = Water Then
Map((c.x + x),(c.y + y)).gScore = Map((c.x),(c.y)).gScore + WaterCost
End If

'Now H score using Manhattan distance
hx = 10 * (ABS(((c.x + x)-(mFinish.x))))
hy = 10 * (ABS(((c.y + y)-(mFinish.y))))

Map((c.x + x),(c.y + y)).hScore = hx + hy

'Finally, the F score

Map((c.x + x),(c.y + y)).fScore = Map((c.x + x),(c.y + y)).gScore + Map((c.x + x),(c.y + y)).hScore

'Make the current square the parent of this square
Map((c.x + x),(c.y + y)).pX = c.x
Map((c.x + x),(c.y + y)).pY = c.y

'Then add this square to the Open List

AddToOpen (c.x + x), (c.y + y)

'If it's the finish square, we've found the path!
If (c.x + x) = mFinish.x And (c.y + y) = mFinish.y Then
onFinish = True
End If

Else 'Then it is on the Open List. Check to see if this is the better route

If Map((c.x + x),(c.y + y)).mType = Ground Then
tempG = Map((c.x),(c.y)).gScore + GroundCost
ElseIF Map((c.x + x),(c.y + y)).mType = Hill Then
tempG = Map((c.x),(c.y)).gScore + HillCost
ElseIf Map((c.x + x),(c.y + y)).mType = Water Then
tempG = Map((c.x),(c.y)).gScore + WaterCost
End If

If tempG < Map((c.x + x),(c.y + y)).gScore Then 'This is the better route
'Make the current square the parent of this square
Map((c.x + x),(c.y + y)).pX = c.x
Map((c.x + x),(c.y + y)).pY = c.y

'Recalculate G and F scores
'G
Map((c.x + x),(c.y + y)).gScore = tempG
'F
Map((c.x + x),(c.y + y)).fScore = Map((c.x + x),(c.y + y)).gScore + Map((c.x + x),(c.y + y)).hScore

End If

End If
End If
End If
Next x
Next y

'Go through the Open List to find the lowest F score
curScore = 20000
For i = 1 to uBound(OpenList)
If Map((OpenList(i).x),(OpenList(i).y)).fScore <= curScore Then
c.x = OpenList(i).x
c.y = OpenList(i).y
curScore = Map((OpenList(i).x),(OpenList(i).y)).fScore
End If
Next i

Loop

'We've found the target square.
Dim onStart As Integer
c.x = mFinish.x
c.y = mFinish.y
i = 1
Do While onStart = False
AddToPath c.x,c.y

If Path(i).x = mStart.x And Path(i).y = mStart.y Then
onStart = True
End If

x = c.x
y = c.y

c.x = Map(x,y).pX 'Make the Current Square the parent square
c.y = Map(x,y).pY

i = i + 1 'Increment i
Loop

End Sub

Sub AddToOpen(x As Integer, y As Integer)
Dim TempOpen(uBound(OpenList)) As PointType

For i = 1 to uBound(OpenList)
TempOpen(i).x = OpenList(i).x
TempOpen(i).y = OpenList(i).y
Next i
size = uBound(OpenList)
Redim OpenList(size+1) As PointType

For i = 1 to uBound(TempOpen)
OpenList(i).x = TempOpen(i).x
OpenList(i).y = TempOpen(i).y
Next i

OpenList(uBound(OpenList)).x = x
OpenList(uBound(OpenList)).y = y
End Sub

Sub AddToClosed(x As Integer, y As Integer)
Dim TempClosed(uBound(ClosedList)) As PointType

For i = 1 to uBound(ClosedList)
TempClosed(i).x = ClosedList(i).x
TempClosed(i).y = ClosedList(i).y
Next i
size = uBound(ClosedList)
Redim ClosedList(size+1) As PointType

For i = 1 to uBound(TempClosed)
ClosedList(i).x = TempClosed(i).x
ClosedList(i).y = TempClosed(i).y
Next i

ClosedList(uBound(ClosedList)).x = x
ClosedList(uBound(ClosedList)).y = y
End Sub

Sub AddToPath(x As Integer, y As Integer)
Dim TempPath(uBound(Path)) As PointType

For i = 1 to uBound(Path)
TempPath(i).x = Path(i).x
TempPath(i).y = Path(i).y
Next i
size = uBound(Path)
Redim Path(size+1) As PointType

For i = 1 to uBound(TempPath)
Path(i).x = TempPath(i).x
Path(i).y = TempPath(i).y
Next i

Path(uBound(Path)).x = x
Path(uBound(Path)).y = y
End Sub

Function IsOnOpen(x As Integer, y As Integer)
For i = 1 to uBound(OpenList)
If OpenList(i).x = x And OpenList(i).y = y Then
'It's on the open list
IsOnOpen = True
Exit For
End If
Next i
End Function

Function IsOnClosed(x As Integer, y As Integer)
For i = 1 to uBound(ClosedList)
If ClosedList(i).x = x And ClosedList(i).y = y Then
'It's on the closed list
IsOnClosed = True
Exit For
End If
Next i
End Function

Sub ClearScreen()
Line (0,0)-(640,480), 0, BF
End Sub

Sub DrawScreen()
For y = 1 to uBound(Map, 2)
For x = 1 to uBound(Map,1)
Square = Map(x,y).mType
Select Case Square
Case Ground: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 2, BF
Case Hill: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 21, BF
Case Water: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 33, BF
Case Wall: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 8, BF
Case Start: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 15, BF
Case Finish: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 4, BF
End Select

Circle (comp.x + 5, comp.y + 5), 3, 14

Locate 1,1
Print "Press any key to continue"
Next x
Next y
End Sub
[/syntax]

It says it looked for and found the path. Good. But when It goes to screen 18, it doesn't do anything. As soon as I press a key, the program closes, and I get a "astar.exe has encountered a problem and needs to close". Any Idea why?[/code]

[Torahteen]

Oh, and using the Visual Studio Disassembler, I have the error point:

Code:

7C911E58  mov         ecx,dword ptr [ecx]

Hope this helps.

[DrV]

Try compiling with -g and running it with gdb or Insight and see which source line causes the error.

[Torahteen]

Is there a way to do this in FB IDE?

[DrV]

Short answer: No.
Long answer: Not yet.

[Torahteen]

So, what do I do then?

[DrV]

Well, you can compile with -g in FBIde; just add -g somewhere in the compiler command line (the same way as you would add -s gui).

Then you need mingw gdb - you can get it here or packaged with Dev-C++.

Then, go to a command prompt, switch to the directory with your executable, and type gdb xyz.exe, where xyz.exe is your executable. Then type r and press enter. When you would normally get an error message from Windows, gdb should stop running the program and show you the line that caused the error. Make note of it and then type q followed by enter to quit (answer y to stop running the program).

[Torahteen]

Now I'm getting an error. Here is what I did.
I copied "Astar.bas" and "board.brd" to the FBIDE main folder. Then opened the command prompt, went to the FBIDE main folder, and typed:
fbc -g Astar.bas
And I get the following error

Astar.bas(71) : error 10: expected '=', found '18'

Line 71 in Astar.bas is

Screen 18

Why is it giving me this error?

[DrV]

Do you have an older (very older ) version of FreeBASIC somewhere on your PATH? Make sure you are using the right fbc (do fbc -version to make sure).

[Torahteen]

Its version 0.13. Is that too old?