My own try at A*

[dumbledore]

mine worked fine for me. it should only look like it's going through walls if you're on windows 98 or 95 and besides, the point behind mine was to be able to make it into a function, therefore what it looks like is irrelevant.

btw, here's my new code, modified with constants and reads from a file, if you're too lazy to hack it yourself:

Code:

#include once "crt.bi"
#define WALL 4
#define FINISH 5
#define START 6

option explicit
option escape

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
declare sub _read( byref var as integer )

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
open "board.brd" for binary as #1
_read mx
_read my
dim as integer 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

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

sub _read( byref var as integer )
    
    dim as ubyte char
    dim as string thing
    
    get #1, , char
    while char <> asc( "," ) and char <> asc( "\n" ) and eof( 1 ) = 0
        thing += chr$( char )
        get #1, , char
    wend
    
    var = val( thing )
    
end sub