Code: Select all
#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
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
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
locate cy + 1, cx + 1: ? " "
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 )
tmpnode = openlist( lowestidx )
removefromopenlist( lowestidx )
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