option predef grmode 700x500

const bl_w = 25

const bl_h = 25

const bl_x = 45

const bl_y = 45

sub draw_walls(x, y)

local px = bl_x + (x * bl_w)

local py = bl_y + (y * bl_h)

rect px, py, step bl_w, bl_h, 1 filled

rect px, py, step bl_w, bl_h, 2

sub draw_target(x, y)

local px = bl_x + (x * bl_w)

local py = bl_y + (y * bl_h)

rect px, py, step bl_w, bl_h, 3 filled

rect px, py, step bl_w, bl_h, 4

sub draw_block(x, y)

local px = bl_x + (x * bl_w) + 1

local py = bl_y + (y * bl_h) + 1

rect px, py, step bl_w - 1, bl_h - 1, 5 filled

rect px, py, step bl_w - 2, bl_h - 2, 6

sub draw_space(x, y)

local px = bl_x + (x * bl_w) + 1

local py = bl_y + (y * bl_h) + 1

rect px, py, step bl_w - 1, bl_h - 1, 8 filled

sub draw_soko(x, y, direction)

local bx = bl_x + (x * bl_w)

local by = bl_y + (y * bl_h)

local dx, dy, PolyArray

dx = bl_w / 5

dy = bl_w / 5

PolyArray = [[3 * dx, 1 * dy], &

[5 * dx, 2 * dy], &

[4 * dx, 2 * dy], &

[4 * dx, 4 * dy], &

[3 * dx, 3 * dy], &

[2 * dx, 4 * dy], &

[2 * dx, 2 * dy], &

[1 * dx, 2 * dy], &

[3 * dx, 1 * dy]]

DrawPoly PolyArray, bx, by Color 9 filled

Circle dx * 3 + bx, by + 5, 3 color 9 filled

sub game_status(byref game)

local help, num_over

' count the number of blocks over the targts

local bl_len = len(game.blocks) - 1

num_over = 0

for i = 0 to bl_len

local block = game.blocks(i)

local x = block(0)

local y = block(1)

if (mid(game.grid(y), x, 1) == ".") then

num_over++

fi

next i

if (num_over == bl_len + 1) then

local y_loc = 5 + txth("T")

for i = 0 to 10

at 10, y_loc

if (i mod 2 == 0) then

? "*** GAME OVER ***"

else

? spc(20)

fi

delay 300

next i

game.game_over = true

fi

color 1,8

help = " [e]=exit, [u]=undo"

at 10, 5: ? cat(1); "Moves: "; game.moves; " Pushes: "; game.pushes; cat(-1); help ; spc(20)

func get_block(byref blocks, x, y)

local i

local result = false

local bl_len = len(game.blocks) - 1

for i = 0 to bl_len

local block = game.blocks(i)

if (block(0) = x && block(1) = y) then

result = true

i = bl_len

fi

next i

get_block = result

sub init_game(grid, byref game)

local row, col, row_len, x, y, ch

dim blocks

' cls

rect 0, 0, xmax, ymax, 8 filled

erase game

y = 0

for row in grid

row_len = len(row)

for x = 1 to row_len

ch = mid(row, x, 1)

select case ch

case "#"' ' border

draw_walls x, y

case "@" ' sokoban man

draw_soko x, y, 1

game.soko_x = x

game.soko_y = y

case "." ' block target

draw_target x, y

case "$" ' moveable block

draw_block x, y

blocks << [x,y]

end select

next i

y++

next row

game.blocks = blocks

game.grid = grid

game.undo_top = 0

dim game.undo

func is_border(byref grid, x, y)

is_border = mid(grid(y), x, 1) == "#"

func is_target(byref game, x, y)

local grid = game.grid

is_target = mid(grid(y), x, 1) == "."

func loadGame(filename)

tload filename, buffer

local blockFound = false

local gameName = ""

local buffLen = len(buffer) - 1

local nextLine, i, firstChar, games, nextGame

dim nextGame

dim games

for i = 0 to buffLen

nextLine = buffer(i)

firstChar = left(trim(nextLine), 1)

if (firstChar == "#") then

' now visiting a game block

blockFound = true

else if firstChar == ";" then

' now visiting a comment

if blockFound then

' store the previously visited game block

games(gameName) = nextGame

fi

blockFound = false

if (len(nextLine) > 2) then

' comment names the next game

gameName = trim(mid(nextLine, 2))

erase nextGame

fi

fi

if (blockFound) then

' append to the next game block

nextGame << nextLine

fi

next i

if blockFound then

' store the last game block

games(gameName) = nextGame

fi

loadGame = games

sub mk_button(byref f, fgc, bgc, x, y, w, h, type)

local button

button.foreground = fgc

button.background = bgc

button.x = x

button.y = y

button.width = w

button.height = h

button.type = type

f.inputs << button

func openFile

local dir_list, file_list, frm, form_var, selected_file

selected_file = ""

'

' get the file list using the current directory

'

sub get_files

local list, f

' empty the arrays

erase dir_list

erase file_list

' re-create as arrays

dim dir_list

dim file_list

if (exist(cwd + "/..")) then

dir_list << ".."

fi

list = files("*")

for f in list

if (!isdir(f)) then

file_list << f

else

dir_list << f

fi

next f

sort dir_list

sort file_list

' sync with first pre-selected file list item

selected_file = iff(empty(file_list), "", file_list(0))

end

sub refresh_form

get_files

frm.inputs(0).label = cwd

frm.inputs(1).value = dir_list

frm.inputs(2).value = file_list

frm.refresh()

end

' prime the initial files arrays

get_files

' define the interface

mk_button(frm, 1, 7, 35, 10, 600, -1, "label")

mk_button(frm, 1, 7, 35, 35, 150, 200, "listbox")

mk_button(frm, 1, 7, -5, 35, 150, 200, "listbox")

mk_button(frm, 1, 7, -5, 35, -5, -5, "button")

mk_button(frm, 1, 7, -5, 35, -5, -5, "button")

frm.inputs(0).label = cwd

frm.inputs(1).value = dir_list

frm.inputs(2).value = file_list

frm.inputs(3).label = "OK"

frm.inputs(4).label = "Cancel"

frm = form(frm)

' run the interface

while 1

frm.doEvents()

form_var = frm.value

select case form_var

case "OK"

exit loop

case "Cancel"

selected_file = ""

exit loop

case ".."

chdir cwd + "/.."

refresh_form

case else

if (isdir(form_var)) then

chdir form_var

refresh_form

else

selected_file = form_var

fi

end select

wend

' close the form

frm.close()

' apply result

openFile = selected_file

sub main

local filename, games, sel_game, game, game_names, i, frm, game_file, start_dir

' remember the starting directory

start_dir = cwd

sub open_game

games = loadGame(game_file)

if (len(games) = 0 && game_file != "sokoban.levels") then

' revert back to the default game file

? " Levels file was empty - reverting to 'sokoban.levels' (Press any key...)"

pause

game_file = start_dir + "sokoban.levels"

games = loadGame(game_file)

fi

if (len(games) > 0) then

' get the sorted list of game names

dim game_names

for i in games

game_names << i

next i

sort game_names

sel_game = game_names(0)

init_game games(sel_game), game

fi

' build the gui

erase frm

mk_button(frm, 1, 7, 5, 1, 100, 20, "choice")

mk_button(frm, 1, 7, -1, 1, -1, 20, "button")

mk_button(frm, 1, 7, -1, 1, -1, 20, "button")

frm.inputs(0).value = game_names

frm.inputs(1).label = "Open"

frm.inputs(2).label = "Play"

frm = form(frm)

end

cls

game_file = "sokoban.levels"

open_game

while 1

frm.doEvents()

select case frm.value

case "Open"

frm.close()

rect 0, 0, xmax, ymax, 8 filled

new_file = openFile

if (len(new_file) > 0 && exist(cwd + new_file)) then

game_file = cwd + new_file

end if

open_game

case "Play"

frm.close()

play_game game

open_game

case else

sel_game = frm.value

init_game games(sel_game), game

end select

wend

sub move_block(byref game, xdir, ydir, x, y)

local i

local bl_len = len(game.blocks) - 1

for i = 0 to bl_len

local block = game.blocks(i)

if (block(0) = x && block(1) = y) then

block(0) = block(0) + xdir

block(1) = block(1) + ydir

draw_block block(0), block(1)

game.blocks(i) = block

i = bl_len

fi

next i

sub move_erase(byref game)

if (is_target(game, game.soko_x, game.soko_y)) then

' redraw the now empty target

draw_target game.soko_x, game.soko_y

else

draw_space game.soko_x, game.soko_y

fi

sub move_up(byref game, is_push)

move_erase game

game.soko_y--

move_erase game

game.moves++

draw_soko game.soko_x, game.soko_y, 1

if is_push then

move_block game, 0, -1, game.soko_x, game.soko_y

game.pushes++

fi

sub move_down(byref game, is_push)

move_erase game

game.soko_y++

move_erase game

game.moves++

draw_soko game.soko_x, game.soko_y, 2

if is_push then

move_block game, 0, 1, game.soko_x, game.soko_y

game.pushes++

fi

sub move_left(byref game, is_push)

move_erase game

game.soko_x--

move_erase game

game.moves++

draw_soko game.soko_x, game.soko_y, 3

if is_push then

move_block game, -1, 0, game.soko_x, game.soko_y

game.pushes++

fi

sub move_right(byref game, is_push)

move_erase game

game.soko_x++

move_erase game

game.moves++

draw_soko game.soko_x, game.soko_y, 4

if is_push then

move_block game, 1, 0, game.soko_x, game.soko_y

game.pushes++

fi

sub play_game(byref game)

local k, ch

repeat: until len(inkey) = 0

game.game_over = false

while game.game_over = false

pause true: k = inkey

if len(k) = 2 then

ch = asc(right(k,1))

select case ch

case "4" 'left arrow"

if (is_border(game.grid, game.soko_x-1, game.soko_y) = false) then

if (get_block(game.blocks, game.soko_x-1, game.soko_y) = false) then

move_left game, false

undo_push game, "R", 0, 0

elif (is_border(game.grid, game.soko_x-2, game.soko_y) = false) then

if (get_block(game.blocks, game.soko_x-2, game.soko_y) = false) then

move_left game, true

undo_push game, "R", game.soko_x-1, game.soko_y

fi

fi

fi

case "5" 'right arrow"

if (is_border(game.grid, game.soko_x+1, game.soko_y) = false) then

if (get_block(game.blocks, game.soko_x+1, game.soko_y) = false) then

move_right game, false

undo_push game, "L", 0, 0

elif (is_border(game.grid, game.soko_x+2, game.soko_y) = false) then

if (get_block(game.blocks, game.soko_x+2, game.soko_y) = false) then

move_right game, true

undo_push game, "L", game.soko_x+1, game.soko_y

fi

fi

fi

case "9" 'up arrow"

if (is_border(game.grid, game.soko_x, game.soko_y-1) = false) then

if (get_block(game.blocks, game.soko_x, game.soko_y-1) = false) then

move_up game, false

undo_push game, "D", 0, 0

elif (is_border(game.grid, game.soko_x, game.soko_y-2) = false) then

if (get_block(game.blocks, game.soko_x, game.soko_y-2) = false) then

move_up game, true

undo_push game, "D", game.soko_x, game.soko_y-1

fi

fi

fi

case "10" 'down arrow"

if (is_border(game.grid, game.soko_x, game.soko_y+1) = false) then

if (get_block(game.blocks, game.soko_x, game.soko_y+1) = false) then

move_down game, false

undo_push game, "U", 0, 0

elif (is_border(game.grid, game.soko_x, game.soko_y+2) = false) then

if (get_block(game.blocks, game.soko_x, game.soko_y+2) = false) then

move_down game, true

undo_push game, "U", game.soko_x, game.soko_y+1

fi

fi

fi

end select

else

select case k

case "r"

restart game

case "u"

undo game

case "e"

game.game_over = true

end select

fi

game_status game

wend

sub restart(byref game)

sub undo(byref game)

local top = len(game.undo) - 1

if (top != -1) then

local undo_el = game.undo(top)

local soko_dir = undo_el.soko_dir

local block_x = undo_el.block_x

local block_y = undo_el.block_y

delete game.undo, top

select case soko_dir

case "U": move_up game, false

case "D": move_down game, false

case "L": move_left game, false

case "R": move_right game, false

end select

if (block_x != 0 && block_y != 0) then

' erase the previous cell

if (is_target(game, block_x, block_y)) then

draw_target block_x, block_y

else

draw_space block_x, block_y

fi

' move to the previous position

select case soko_dir

case "U": move_block game, 0, -1, block_x, block_y

case "D": move_block game, 0, 1, block_x, block_y

case "L": move_block game, -1, 0, block_x, block_y

case "R": move_block game, 1, 0, block_x, block_y

end select

fi

fi

sub undo_push(byref game, soko_dir, block_x, block_y)

local undo_el

undo_el.soko_dir = soko_dir

undo_el.block_x = block_x

undo_el.block_y = block_y

game.undo << undo_el

main