Posts: 684
Threads: 64
Joined: May 2004
Yes, I know this has already been done. But hey, why not.
Make an A* pathfinder in FB:
- Must use A* algorithm (Yes, it's neccisary )
- Any Heuristic is allowed.
- Use different ground costs. Ground types include: Ground, Hills, Water, Walls, etc.
- Allow the ability to easily change the "board". I plan to use my own board to test it out.
- Have fun with it. I know it's A*, but try your best
[/list:o]
I'll make my own A* routine. This is a challenge, not a contest. Good luck!
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Posts: 684
Threads: 64
Joined: May 2004
Here is my code! I've posted it in the Projects Thread already but...
[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 = 2
const Water = 1
const Wall = 4
const Start = 6
const Finish = 5
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
cls
Screen 18
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"
sleep
ClearScreen
DrawScreen
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 IsOnClosed((OpenList(i).x),(OpenList(i).y)) = False Then
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
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 c.x = mStart.x And c.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)-(319,199), 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
Next x
Next y
Dim ox, oy As Integer
ox = mFinish.x
oy = mFinish.y
For i = 1 To uBound(Path)
x = Path(i).x
y = Path(i).y
Line (ox * 10 + 5,oy * 10 + 5)-(x * 10 + 5,y * 10 + 5), 14
ox = x
oy = y
Next i
Locate 20,1
For i = 1 To uBound(Path)
Print Path(i).x;
Print ",";
Print Path(i).y;
Next i
End Sub
[/syntax]
You'll need to make a "board.brd" file to use it. Here is a sample board.
Code: 20,15
0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,5,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,2,2,2,2,2,2,1,1,2,2,2,0,0,0,0,0
0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0
0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0
0,0,0,0,2,2,2,2,2,1,1,2,2,2,0,0,0,0,0,0
0,0,0,0,0,0,2,2,2,2,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,2,2,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,6,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Posts: 684
Threads: 64
Joined: May 2004
Hmm... nobody wants to do this eh? Oh well, it was worth a shot. At least two other people are making one.
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Posts: 489
Threads: 34
Joined: Jan 2005
mine was already under the projects forum too... fb only
[syntax="qbasic"]#include once "crt.bi"
#define WALL 4
#define FINISH 5
#define START 6
option explicit
type coord
x as ubyte
y as ubyte
end type
type node
x as ubyte
y as ubyte
g as integer
f as integer
p as node ptr
end type
declare function timesvisited( byval x as integer, byval y as integer ) as byte
declare function outofbounds( byval x as integer, byval y as integer ) as byte
declare function onclosedlist( byref what as coord ) as byte
declare function removefromopenlist( byval idx as integer ) as byte
declare function onopenlist( byref what as coord ) as byte
redim preserve shared openlist( 0 ) as node ptr, closedlist( 1 ) as coord, allnodes( 0 ) as node ptr
dim as integer rx, ry, cx, cy, ex, ey, i
dim as string yn
input "show path? [y/n]:", yn
yn = ucase$( left$( yn, 1 ) )
cls
dim shared as integer mx, my
read mx
read my
dim as ubyte room( mx * my )
for ry = 0 to my - 1
for rx = 0 to mx - 1
read room( rx + ry * mx )
select case room( rx + ry * mx )
case WALL
? "|";
case START
? "@";
cx = rx
cy = ry
closedlist( 0 ).x = rx
closedlist( 0 ).y = ry
case FINISH
? "*";
ex = rx
ey = ry
case else
? " ";
end select
next
?
next
if yn = "Y" then sleep
dim as node ptr tmpnode
tmpnode = callocate( len( node ) )
tmpnode->x = cx
tmpnode->y = cy
allnodes( ubound( allnodes ) ) = tmpnode
redim preserve shared allnodes( ubound( allnodes ) + 1 )
while cx <> ex or cy <> ey
dim as integer max = 100, aye, x, y
aye = 0
for x = -1 to 1
for y = -1 to 1 step 1 - ( x = 0 )
dim as coord working
working.x = cx + x
working.y = cy + y
if onclosedlist( working ) = 0 and onopenlist( working ) = 0 and _
room( cx + x + ( cy + y ) * mx ) <> WALL and _
room( cx + ( cy + y ) * mx ) <> WALL and _
room( cx + x + cy * mx ) <> WALL and _
outofbounds( cx + x, cy + y ) = 0 then
openlist( ubound( openlist ) ) = callocate( len( node ) )
dim as node ptr temp
temp = openlist( ubound( openlist ) ) '' use a temp var so we don't have to
'' keep using ubound()
temp->x = working.x
temp->y = working.y
temp->f = 10 * sqr( abs( x ) + abs( y ) ) + _ '' the g score
10 * sqr( ( cx + x - ex ) ^ 2 + ( cy + y - ey ) ^ 2 ) '' the h score
if temp->f > max then max = temp->f
temp->p = tmpnode
allnodes( ubound( allnodes ) ) = temp
redim preserve shared allnodes( ubound( allnodes ) + 1 )
redim preserve shared openlist( ubound( openlist ) + 1 )
end if
next
next
dim as integer lowest, lowestidx = 0
lowest = max + 1
for i = 0 to ubound( openlist ) - 1
if openlist( i )->f < lowest and openlist( i )->f <> -1 then
lowest = openlist( i )->f
lowestidx = i
end if
next
if yn = "Y" then locate cy + 1, cx + 1: ? " "
if lowest <> max + 1 then
cx = openlist( lowestidx )->x
cy = openlist( lowestidx )->y
end if
if yn = "Y" then locate cy + 1, cx + 1: ? "@"
closedlist( ubound( closedlist ) ).x = cx
closedlist( ubound( closedlist ) ).y = cy
redim preserve shared closedlist( ubound( closedlist ) + 1 )
tmpnode = openlist( lowestidx )
removefromopenlist( lowestidx )
if yn = "Y" then sleep
wend
'' as a function this would return tmpnode
while tmpnode <> 0
locate tmpnode->y + 1, tmpnode->x + 1
? "*"
tmpnode = tmpnode->p
wend
'' it will be necessary to clean up memory afterward, otherwise we'll end up with
'' a leak the size of the pacific ocean ;P
for i = 0 to ubound( allnodes )
deallocate allnodes( i )
next
sleep
end
data 12,10
data 4,4,4,4,4,4,4,4,4,4,4,4
data 4,0,0,0,0,0,0,0,0,0,0,4
data 4,0,0,0,0,0,0,0,0,0,0,4
data 4,0,0,0,4,4,4,0,0,0,0,4
data 4,0,0,0,0,0,0,4,0,0,0,4
data 4,0,0,0,0,6,0,4,0,5,0,4
data 4,0,0,0,0,0,0,4,0,0,0,4
data 4,0,0,0,4,4,4,0,0,0,0,4
data 4,0,0,0,0,0,0,0,0,0,0,4
data 4,4,4,4,4,4,4,4,4,4,4,4
function outofbounds( byval x as integer, byval y as integer ) as byte
return x < 0 or x > mx - 1 or y < 0 or y > my - 1
end function
function onclosedlist( byref what as coord ) as byte
dim as integer i
for i = 0 to ubound( closedlist ) - 1
if memcmp( @closedlist( i ), @what, len( coord ) ) = 0 then return -1
next
return 0
end function
function removefromopenlist( byval idx as integer ) as byte
if idx > ubound( openlist ) then return 0
dim as integer i
for i = idx to ubound( openlist ) - 1
openlist( i ) = openlist( i + 1 )
next
redim preserve openlist( ubound( openlist ) - 1 )
return -1
end function
function onopenlist( byref what as coord ) as byte
dim as integer i
for i = 0 to ubound( openlist ) - 1
if memcmp( openlist( i ), @what, len( coord ) ) = 0 then return -1
next
return 0
end function
[/syntax]
ttp://m0n573r.afraid.org/
Quote:quote: "<+whtiger> you... you don't know which way the earth spins?" ... see... stupidity leads to reverence, reverence to shakiness, shakiness to... the dark side
...phear
Posts: 163
Threads: 41
Joined: Jan 2005
I don't see how coding it in fb is any different from coding it in qb...I've done a qb version does that count?
am part of the legion of n00b. We are numerous if dumb. We will enslave you all!
Posts: 2,765
Threads: 138
Joined: Nov 2002
Quote:I don't see how coding it in fb is any different from coding it in qb..
FB has some more helpful advanced functions ect ect
soo a QB version should work ^^
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 1,025
Threads: 44
Joined: May 2005
Ok, I completely redid my code....Here it is...this one supports multivalue land and diagonals...
Code: '*******************************************************************************
'Uses my own version of the a* pathfinding algorithim to store *
'*******************************************************************************
Declare Function FindPath (argStartX As Integer, argStartY As Integer, argDestX As Integer, argDestY As Integer ) As Integer
'*******************************************************************************
'Node Handling Subs for pathfinding *
'*******************************************************************************
Declare Sub SpawnNode ( argX As Integer, argY As Integer, argParent As Integer, argStepCost As Double, argRealCost As Double, argMultiplier As Double, argSteps As Integer )
Declare Sub HandleNodes()
'*******************************************************************************
'Node Handling Functions *
'*******************************************************************************
Declare Function UnusedNode () As Integer 'find an unused node
Declare Function NodeCollideCompare ( argX As Integer, argY As Integer, argCompareCost As Double ) As Integer 'see if a spot already has a node
Declare Function AllNodesClosed () As Integer 'see if we are done
Const True = -1
Const False = Not True
Const CUnused = 0
Const COpen = 1
Const CClosed = 2
'Tiletype constants
Const CWall = 0
Const CFloor = 1
'Generating Maximum Constants
Const MaxPaths = 500
Const MaxNodes = 1000
Const StraightCost = 1
Const DiagonalCost = SQR(2)
Type NodeType ' used by the algorithim to find a path
X As Integer 'horizontal position
Y As Integer 'vertical position
Parent As Integer 'index # of parent node
Status As Byte 'unused, open, closed
Steps As Integer 'how many steps, regardless of diagonal/straight
StepCost As Double 'doesn't factor different type of enviro
RealCost As Double 'does factor real enviro
End Type
Type PathType 'used to record the steps of a path
Steps As Integer 'how many steps
X( MaxPaths - 1 ) As Integer 'max of 500 steps
Y( MaxPaths - 1 ) As Integer 'max of 500 steps
InUse As Byte 'is this in use
End Type
Dim Shared Node( MaxNodes - 1 ) As NodeType
Dim Shared Path( 99 ) As PathType 'stores a max of 100, 500 step paths
Dim Shared MapMaxX, MapMaxY
Read MapMaxX, MapMaxY
Redim Shared Map( -1 to MapMaxX , -1 to MapMaxY ) As Integer
For TempY = 0 To MapMaxY - 1
For TempX = 0 To MapMaxX - 1
Read TempTile
Map( TempY, TempX ) = TempTile
Locate TempY + 1, TempX * 2 + 1: Print TempTile
Next TempX
Next TempY
Dim Shared CurNode As Integer
Dim PathIn As Integer
Dim TempS As Integer
color 4
print path( pathin ).steps
color 15
PathIn = FindPath (0, 0, 9, 9)
For TempS = 0 to Path( PathIn ).Steps
Locate Path( PathIn ).Y( TempS ) + 1, Path( PathIn ).X( TempS ) * 2 + 1
color 4
sleep
print " P"'Map(Path( PathIn ).X( TempS ) , Path( PathIn ).Y( TempS ) )
next tempS
sleep
'*******************************************************************************
'Following function stores a path and then returns the index it's stored at *
'*******************************************************************************
Function FindPath (argStartX As Integer, argStartY As Integer, argDestX As Integer, argDestY As Integer ) As Integer
Dim TempLowestVal As Double 'lowest cost path
Dim TempLowestNum As Integer 'index of lowest cost path node
Dim TempNode As Integer
Dim TempPath As Integer
Dim TempCount As Integer
CurNode = 0
Node( CurNode ).X = argStartX
Node( CurNode ).Y = argStartY
Node( CurNode ).Status = COpen
Node( CurNode ).Steps = 0
Node( CurNode ).StepCost = 0
Node( CurNode ).RealCost = 0
Do
HandleNodes
Loop Until AllNodesClosed
TempLowestVal = 100000000 'some ridiculous number so that it gets overridden
TempLowestNum = -1 'give a illegal number to determine whether or not there is a path
For TempNode = 1 To MaxNodes - 1'we know that 0 cannot be it, unless start and dest are the same
If Node( TempNode ).X = argDestX Then 'if in the right column...
If Node( TempNode ).Y = argDestY Then '...and the right row
If Node( TempNode ).RealCost < TempLowestVal Then 'if this path costs less
TempLowestVal = Node( TempNode ).RealCost 'overwrite current lowest data
TempLowestNum = TempNode
End if
End If
End If
Next TempNode
If TempLowestNum >= 0 Then
For TempPath = 0 to MaxPaths - 1
If Path( TempPath ).InUse = False Then
TempNode = TempLowestNum
Path( TempPath ).Steps = Node( TempNode ).Steps
Path( TempPath ).InUse = True
For TempCount = Node( TempNode ).Steps To 0 Step -1 'have to count down due to the properties of parents
Path( TempPath ).Y( TempCount ) = Node( TempNode ).X
Path( TempPath ).X( TempCount ) = Node( TempNode ).Y
TempNode = Node( TempNode ).Parent 'go back one step, until we reach origin
Next TempCount
Return TempPath 'return the index of where we stored the path
End If
Next TempPath
End If
Return -1 'return an illegal index number, there is no path
End Function
'*******************************************************************************
'Node Spawning Sub. Give it the new x, y. parents #, parents step and real cost*
'and the multiplier that corresponds to the new nodes direction to the parent *
'*******************************************************************************
Sub SpawnNode ( argX As Integer, argY As Integer, argParent As Integer, argStepCost As Double, argRealCost As Double, argMultiplier As Double, argSteps As Integer )
If argX < 0 Or argX >= MapMaxX Then Exit Sub
If argY < 0 Or argY >= MapMaxY Then Exit Sub
If Map( argX, argY ) = CWall Then Exit Sub
Dim TempNode As Integer
Dim TempRealCost As Double
Dim wt as Double
TempRealCost = argRealCost + Map( argX, argY ) * argMultiplier
If NodeCollideCompare( argX, argY, TempRealCost ) = False Then
TempNode = UnusedNode
Node( TempNode ).X = argX
Node( TempNode ).Y = argY
Node( TempNode ).Parent = argParent
Node( TempNode ).Status = COpen
Node( TempNode ).StepCost = argStepCost + argMultiplier
Node( TempNode ).RealCost = TempRealCost
Node( TempNode ).Steps = argSteps + 1
End If
End Sub
'*******************************************************************************
'spawn children then close the node *
'*******************************************************************************
Sub HandleNodes()
Dim TempNode As Integer
Dim TempX As Integer, TempY As Integer
For TempNode = 0 to MaxNodes - 1
If Node( TempNode ).Status = COpen Then
For TempX = -1 to 1
For TempY = -1 to 1
If Map(TempX + Node( TempNode ).X , TempY+Node( TempNode ).Y ) <> CWall Then
If Abs( TempX ) + Abs( TempY ) = 1 Then 'if walking straight
SpawnNode Node( TempNode ).X + TempX, Node( TempNode ).Y + TempY, TempNode, Node( TempNode ).StepCost, Node( TempNode ).RealCost, StraightCost, Node( TempNode ).Steps
End If
If Abs( TempX ) + Abs( TempY ) = 2 Then 'if walking diagonal
SpawnNode Node( TempNode ).X + TempX, Node( TempNode ).Y + TempY, TempNode, Node( TempNode ).StepCost, Node( TempNode ).RealCost, DiagonalCost, Node( TempNode ).Steps
End If
End If
Next TempY
Next TempX
Node( TempNode ).Status = CClosed
End If
Next TempNode
End Sub
'*******************************************************************************
'Node Handling Functions *
'*******************************************************************************
Function UnusedNode () As Integer 'find an unused node
CurNode +=1
Return CurNode
End Function
'*******************************************************************************
'Check to see if a spot already contains a node, and then if it is better, *
'return true *
'*******************************************************************************
Function NodeCollideCompare ( argX As Integer, argY As Integer, argCompareCost As Double ) As Integer
Dim TempNode As Integer
For TempNode = 0 To MaxNodes - 1
If Node( TempNode ).X = argX Then
If Node( TempNode ).Y = argY Then
If Node( TempNode ).RealCost <= argCompareCost Then 'if the current node there costs less
Return True 'then tell it there is a better one
End if
End If
End If
Next TempNode
Return False
End Function
'*******************************************************************************
'Check to see if all nodes are either closed or unused *
'*******************************************************************************
Function AllNodesClosed () As Integer 'see if we are done
Dim TempNode As Integer
For TempNode = 0 to MaxNodes - 1
If Node( TempNode ).Status = COpen Then Return False
Next TempNode
Return True
End Function
Data 10,10
Data 1,1,1,1,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,0,0,1
Data 1,0,1,1,1,1,1,1,1,1
Data 1,0,1,1,1,1,1,1,1,1
Data 0,0,1,0,0,0,0,0,0,0
Data 1,1,1,0,1,1,1,0,1,1
Data 1,1,1,0,1,0,1,0,1,1
Data 1,1,1,0,1,0,1,0,1,1
Data 1,1,1,1,1,0,1,1,1,1
Data 1,1,1,1,1,0,1,1,1,1
Posts: 1,025
Threads: 44
Joined: May 2005
I edited my code....comments on the new code are welcome.
Posts: 500
Threads: 7
Joined: Jun 2005
What FBC version are you using? It renders errors in 0.13. . .
For example, SQR(2) is not a constant. You could use #define DiagonalCost = SQR(2) for that one.
974277320612072617420666C61696C21 (Hexadecimal for those who don't know)
Posts: 1,025
Threads: 44
Joined: May 2005
I am using the latest version of FBC, which is 14. And I get no errors....
And the last time I checked...the square root of two never changes.
|