My own try at A*

[dumbledore]

here's mine again, but with open/closed lists... hopefully this time it's easier to read :lol: :wink:

Code:

#include once "crt.bi"

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 integer
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 addtopath( byval s as integer, byval x as ubyte, byval y as ubyte ) as byte
declare function onopenlist( byref what as coord ) as byte

redim preserve shared openlist( 0 ) as node, closedlist( 1 ) as coord, path( 1 ) as coord
dim as integer rx, ry, cx, cy, ex, ey, i

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 1
            ? "|";
        case 2
            ? "@";
            cx = rx
            cy = ry
            path( 0 ).x = rx
            path( 0 ).y = ry
            closedlist( 0 ).x = rx
            closedlist( 0 ).y = ry
        case 3
            ? "*";
            ex = rx
            ey = ry
        case else
            ? " ";
        end select
    next
    ?
next

sleep

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 ) <> 1 and room( cx + ( cy + y ) * mx ) <> 1 and room( cx + x + cy * mx ) <> 1 and outofbounds( cx + x, cy + y ) = 0 then
                
                openlist( ubound( openlist ) ).x = working.x
                openlist( ubound( openlist ) ).y = working.y
                
                openlist( ubound( openlist ) ).f = 10 * sqr( abs( x ) + abs( y ) ) + 10 * sqr( ( cx + x - ex ) ^ 2 + ( cy + y - ey ) ^ 2 )
                if openlist( ubound( openlist ) ).f > max then max = openlist( ubound( openlist ) ).f
                openlist( ubound( openlist ) ).p = ubound( path ) - 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
    next
    
    locate cy + 1, cx + 1: ? " "
    
    addtopath( openlist( lowestidx ).p, openlist( lowestidx ).x, openlist( lowestidx ).y )
    
    if lowest <> max + 1 then
        cx = openlist( lowestidx ).x
        cy = openlist( lowestidx ).y
    end if
    
    locate cy + 1, cx + 1: ? "@"
    
    closedlist( ubound( closedlist ) ).x = cx
    closedlist( ubound( closedlist ) ).y = cy
    redim preserve shared closedlist( ubound( closedlist ) + 1 )
    
    removefromopenlist( lowestidx )
    
    if cx = ex and cy = ey then locate 9,9: ? "done!"
    
    sleep
    
wend

for i = 0 to ubound( path ) - 1
    locate path( i ).y + 1, path( i ).x + 1
    ? "*"
next

sleep

data 8,5
data 0,0,0,0,0,0,0,1
data 0,0,0,1,1,1,1,1
data 0,2,0,1,1,0,3,0
data 0,0,0,1,1,0,0,0
data 0,0,0,0,0,0,0,0

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
    for i = idx to ubound( openlist ) - 1
        openlist( i ) = openlist( i + 1 )
    next
    redim preserve openlist( ubound( openlist ) - 1 )
    
    return -1
    
end function

function addtopath( byval s as integer, byval x as ubyte, byval y as ubyte ) as byte
    
    path( s + 1 ).x = x
    path( s + 1 ).y = y
    
    redim preserve path( s + 2 )
    
    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