Qbasicnews.com
September 19, 2019, 03:45:42 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: A* in FB  (Read 5949 times)
Torahteen
Ancient Guru
****
Posts: 744



« on: June 29, 2005, 11:57:27 AM »

Yes, I know this has already been done. But hey, why not.
Make an A* pathfinder in FB:
[list=1]
  • Must use A* algorithm (Yes, it's neccisary Wink)
  • 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 Wink
  • [/list:o]

    I'll make my own A* routine. This is a challenge, not a contest. Good luck!  Cheesy
Logged

quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Torahteen
Ancient Guru
****
Posts: 744



« Reply #1 on: June 30, 2005, 12:27:38 PM »

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
Logged

quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Torahteen
Ancient Guru
****
Posts: 744



« Reply #2 on: July 02, 2005, 01:41:49 AM »

Hmm... nobody wants to do this eh? Sad  Oh well, it was worth a shot. At least two other people are making one.
Logged

quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
dumbledore
Ancient Guru
****
Posts: 520



WWW
« Reply #3 on: July 02, 2005, 03:55:47 AM »

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]
Logged

ttp://m0n573r.afraid.org/
Quote from: "HexDude"
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
SBM Productions
Senior Member
**
Posts: 163


« Reply #4 on: July 04, 2005, 12:20:09 PM »

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?
Logged

 am part of the legion of n00b. We are numerous if dumb. We will enslave you all!
whitetiger0990
__/--\__
*****
Posts: 2964



WWW
« Reply #5 on: July 04, 2005, 01:06:43 PM »

Quote from: "SBM Productions"
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 ^^
Logged


[size=10]Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.[/size]
Deleter
Na_th_an
*****
Posts: 1292



WWW
« Reply #6 on: July 05, 2005, 12:13:04 AM »

Ok, I completely redid my code....Here it is...this one supports multivalue land and diagonals...Smiley
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
Logged

Deleter
Na_th_an
*****
Posts: 1292



WWW
« Reply #7 on: July 06, 2005, 05:09:54 PM »

I edited my code....comments on the new code are welcome. Smiley
Logged

rpgfan3233
Ancient Guru
****
Posts: 617



« Reply #8 on: July 06, 2005, 05:15:12 PM »

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.
Logged

974277320612072617420666C61696C21 (Hexadecimal for those who don't know)
Deleter
Na_th_an
*****
Posts: 1292



WWW
« Reply #9 on: July 06, 2005, 05:23:00 PM »

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. Tongue
Logged

Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!