$ include "seed7_05.s7i";
include "float.s7i";
include "text.s7i";
include "draw.s7i";
include "pic32.s7i";
include "pic_util.s7i";
include "stdfont9.s7i";
include "pixmap_file.s7i";
include "keybd.s7i";
include "editline.s7i";
include "echo.s7i";
include "line.s7i";
include "dialog.s7i";
include "time.s7i";
include "duration.s7i";
include "sokoban1.s7i";
const integer: TILE_SIZE is 32;
var integer: numberOfMoves is 0;
var integer: numberOfPushes is 0;
var integer: levelNumber is 1;
var integer: numberOfPackets is 0;
var integer: savedPackets is 0;
var integer: xPos is -1;
var integer: yPos is -1;
const type: categoryType is new enum
WALL, GROUND, PLAYER, PACKET, OUTSIDE
end enum;
const type: fieldType is new struct
var categoryType: fieldCategory is GROUND;
var boolean: isGoalField is FALSE;
var boolean: dirty is TRUE;
end struct;
var array array fieldType: levelMap is 0 times 0 times fieldType.value;
var char: keyChar is ' ';
var text: win is STD_NULL;
var PRIMITIVE_WINDOW: player_pixmap is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: goal_pixmap is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: wall_pixmap is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: packet_pixmap is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: player_at_goal_pixmap is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: packet_at_goal_pixmap is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: undo_button is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: redo_button is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: quit_button is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: next_button is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: previous_button is PRIMITIVE_WINDOW.value;
var PRIMITIVE_WINDOW: restart_button is PRIMITIVE_WINDOW.value;
const type: moveMode is new enum
MOVE, PUSH
end enum;
const type: moveDirection is new enum
UP, DOWN, LEFT, RIGHT
end enum;
const type: moveType is new struct
var moveMode: mode is MOVE;
var moveDirection: direction is UP;
end struct;
var array moveType: playerMoves is 0 times moveType.value;
var integer: moveNumber is 0;
const array string: player_pic is [](
"bbbbbbbbbbbbbbYYYYYbbbbbbbbbbbbb",
"bbbbbbbbbbbbbYYYYYYYbbbbbbbbbbbb",
"bbbbbbbbbbbbYYWWWWWYYbbbbbbbbbbb",
"bbbbbbbbbbbbYYWBWBWYYbbbbbbbbbbb",
"bbbbbbbbbbbbYYWWWWWYYbbbbbbbbbbb",
"bbbbbbbbbbbbYYWOWOWYYbbbbbbbbbbb",
"bbbbbbbbbbbbbbWWOWWbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbbWWWbbbbbbbbbbbbbb",
"bbbbbbbbbbbbOOOWWWOOObbbbbbbbbbb",
"bbbbbbbbbbbOOOOOOOOOOObbbbbbbbbb",
"bbbbbbbbbbOOOOOOOOOOOOObbbbbbbbb",
"bbbbbbbbbOOOMOOMOMOOMOOObbbbbbbb",
"bbbbbbbbWWObbMMOOOMMbbOWWbbbbbbb",
"bbbbbbWWWWbbbbOOOOObbbbWWWWbbbbb",
"bbbbbWWWWbbbbbOOOOObbbbbWWWWbbbb",
"bbbbbWWWbbbbbOOOOOOObbbbbWWWbbbb",
"bbbbbbbbbbbbXXXXXXXXXbbbbbbbbbbb",
"bbbbbbbbbbbbBBBBBBBBBbbbbbbbbbbb",
"bbbbbbbbbbbbBBBBBBBBBbbbbbbbbbbb",
"bbbbbbbbbbbbBBBBBBBBBbbbbbbbbbbb",
"bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb",
"bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb",
"bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb",
"bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb",
"bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb",
"bbbbbbbbbbbbbWWWbWWWbbbbbbbbbbbb");
const array string: goal_pic is [](
" ",
" MMMMM MMMMM MMMMM MMMMM MMMMM ",
" M MMM M MMM M MMM M MMM M MMM ",
" MM M MMM M MMM M MMM M MMM M M ",
" MMM MMMMM MMMMM MMMMM MMMMM MM ",
" MM M MMM M MMM M MMM M MMM M M ",
" M MMM M MMM M MMM M MMM M MMM ",
" MMMMM MMMMM MMMMM MMMMM MMMMM ",
" M MMM M MMM M MMM M MMM M MMM ",
" MM M MMM M MMM M MMM M MMM M M ",
" MMM MMMMM MMMMM MMMMM MMMMM MM ",
" MM M MMM M MMM M MMM M MMM M M ",
" M MMM M MMM M MMM M MMM M MMM ",
" MMMMM MMMMM MMMMM MMMMM MMMMM ",
" M MMM M MMM M MMM M MMM M MMM ",
" MM M MMM M MMM M MMM M MMM M M ",
" MMM MMMMM MMMMM MMMMM MMMMM MM ",
" MM M MMM M MMM M MMM M MMM M M ",
" M MMM M MMM M MMM M MMM M MMM ",
" MMMMM MMMMM MMMMM MMMMM MMMMM ",
" M MMM M MMM M MMM M MMM M MMM ",
" MM M MMM M MMM M MMM M MMM M M ",
" MMM MMMMM MMMMM MMMMM MMMMM MM ",
" MM M MMM M MMM M MMM M MMM M M ",
" M MMM M MMM M MMM M MMM M MMM ",
" MMMMM MMMMM MMMMM MMMMM MMMMM ",
" M MMM M MMM M MMM M MMM M MMM ",
" MM M MMM M MMM M MMM M MMM M M ",
" MMM MMMMM MMMMM MMMMM MMMMM MM ",
" MM M MMM M MMM M MMM M MMM M M ",
" M MMM M MMM M MMM M MMM M MMM ",
" ");
const array string: wall_pic is [](
"xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx",
"xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx",
"xxxxWWWWWWWWWWWWWWWWWWWxxxxxxxxx",
"xxxxWxxxxxxxxxxxWxxxxxWxxxxxxxxx",
"WWWWWxxxxxxxxxxxWxxxxxWWWWWWWWWW",
"xxxxWxxxxxxxxxxxWxxxxxWxxxxxxxxx",
"xxxxWxxxxxxxxxxxWxxxxxWxxxxxxxxx",
"WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW",
"xxxxxxxxxWxxxxxxxxxWxxxxxxxWxxxx",
"xxxxxxxxxWxxxxxxxxxWxxxxxxxWxxxx",
"xxxxxxxxxWxxxxxxxxxWxxxxxxxWxxxx",
"WWWWWWWWWWxxxxxxxxxWWWWWWWWWWWWW",
"xxxWxxxxxWWWWWWWWWWWxxxxxxxxxxxx",
"xxxWxxxxxWxxxxxxxxxWxxxxxxxxxxxx",
"xxxWxxxxxWxxxxxxxxxWxxxxxxxxxxxx",
"xxxWxxxxxWxxxxxxxxxWxxxxxxxxxxxx",
"WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW",
"xxxxxWxxxxxxxxWxxxxxxxxxxxWxxxxx",
"xxxxxWxxxxxxxxWxxxxxxxxxxxWxxxxx",
"xxxxxWxxxxxxxxWxxxxxxxxxxxWxxxxx",
"xxxxxWWWWWWWWWWWWWWWWWWWWWWxxxxx",
"xxxxxWxxxxxxxxxxxWxxxxxxxxWxxxxx",
"xxxxxWxxxxxxxxxxxWxxxxxxxxWxxxxx",
"xxxxxWxxxxxxxxxxxWxxxxxxxxWxxxxx",
"WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW",
"xxxxxxxxxxxxWxxxxxxxxxWxxxxxWxxx",
"xxxxxxxxxxxxWxxxxxxxxxWxxxxxWxxx",
"xxxxxxxxxxxxWxxxxxxxxxWxxxxxWxxx",
"xxxxxxxxxxxxWWWWWWWWWWWxxxxxWxxx",
"WWWWWWWWWWWWWxxxxxxxxxWWWWWWWWWW",
"xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx",
"xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx");
const array string: packet_pic is [](
"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb",
"bbbbbbbbbbbbXXXXXXXXXbbbbbbbbbbb",
"bbbbbbbbbbXXXWWWWWWWXXXbbbbbbbbb",
"bbbbbbbbXXXWWWWWWWWWWWXXXbbbbbbb",
"bbbbbbbXXWWWWRRRRRRRWWWWXXbbbbbb",
"bbbbbbXXWWWRRRRRRRRRRRWWWXXbbbbb",
"bbbbbXXWWRRRRRRYYYYRRRRRWWXXbbbb",
"bbbbbXWWRRRRRRRRRYYYYRRRRWWXbbbb",
"bbbbXXWWRRRRRRRRRRRYYYRRRWWXXbbb",
"bbbbXWWRRRRRRRRRRRRRYYYRRRWWXbbb",
"bbbbXWWRRRRRRRRRRRRRRYYYRRWWXbbb",
"bbbXWWRRRRRRRRRRRRRRRRYYRRRWWXbb",
"bbbXWWRRRRRRRRRRRRRRRRRYRRRWWXbb",
"bbbXWWRRRRRRRRRRRRRRRRRYRRRWWXbb",
"bbbXWWRRRRRRRRRRRRRRRRRRRRRWWXbb",
"bbbXWWRRRBRRRRRRRRRRRRRRRRRWWXbb",
"bbbXWWRRRBRRRRRRRRRRRRRRRRRWWXbb",
"bbbXWWRRRBBRRRRRRRRRRRRRRRRWWXbb",
"bbbXXWWRRBBBRRRRRRRRRRRRRRWWXXbb",
"bbbbXWWRRRBBBRRRRRRRRRRRRRWWXbbb",
"bbbbXXWWRRRBBBRRRRRRRRRRRWWXXbbb",
"bbbbbXWWRRRRBBBBRRRRRRRRRWWXbbbb",
"bbbbbXXWWRRRRRBBBBRRRRRRWWXXbbbb",
"bbbbbbXXWWWRRRRRRRRRRRWWWXXbbbbb",
"bbbbbbbXXWWWWRRRRRRRWWWWXXbbbbbb",
"bbbbbbbbXXXWWWWWWWWWWWXXXbbbbbbb",
"bbbbbbbbbbXXXWWWWWWWXXXbbbbbbbbb",
"bbbbbbbbbbbbXXXXXXXXXbbbbbbbbbbb",
"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb",
"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb");
const array string: player_at_goal_pic is [](
" YYYYY ",
" MMMMM MMMMMYYYYYYYMMMMM MMMMM ",
" M MMM M MMMYYWWWWWYYMMM M MMM ",
" MM M MMM M YYWBWBWYY M MMM M M ",
" MMM MMMMM MYYWWWWWYYM MMMMM MM ",
" MM M MMM M YYWOWOWYY M MMM M M ",
" M MMM M MMM MWWOWWM MMM M MMM ",
" MMMMM MMMMM MWWWM MMMMM MMMMM ",
" M MMM M MMMOOOWWWOOOMMM M MMM ",
" MM M MMM MOOOOOOOOOOOM MMM M M ",
" MMM MMMMMOOOOOOOOOOOOOMMMMM MM ",
" MM M MMMOOOMOOMOMOOMOOOMMM M M ",
" M MMM MWWOM MMOOOMM MOWWM MMM ",
" MMMMWWWWMMM OOOOO MMMWWWWMMMM ",
" M MMWWWWMMM MOOOOOM MMMWWWWMM ",
" MM MWWWM M MOOOOOOOM M MWWWM M ",
" MMM MMMMM MXXXXXXXXXM MMMMM MM ",
" MM M MMM M BBBBBBBBB M MMM M M ",
" M MMM M MMMBBBBBBBBBMMM M MMM ",
" MMMMM MMMMBBBBBBBBBMMMM MMMMM ",
" M MMM M MMM BBBMBBB MMM M MMM ",
" MM M MMM M MBBBMBBBM M MMM M M ",
" MMM MMMMM MMBBB BBBMM MMMMM MM ",
" MM M MMM M MBBBMBBBM M MMM M M ",
" M MMM M MMM MBBMBBM MMM M MMM ",
" MMMMM MMMMM BBMBB MMMMM MMMMM ",
" M MMM M MMM MBBMBBM MMM M MMM ",
" MM M MMM M MMBBMBBMM M MMM M M ",
" MMM MMMMM MMMBB BBMMM MMMMM MM ",
" MM M MMM M MMBBMBBMM M MMM M M ",
" M MMM M MMMSMBBMBBM MMM M MMM ",
" WWW WWW ");
const array string: packet_at_goal_pic is [](
" ",
" MMMMM MMMMM MMMMM MMMMM MMMMM ",
" M MMM M MMM M MMM M MMM M MMM ",
" MM M MMM M MWWWWWWWM M MMM M M ",
" MMM MMMMMWWWWWWWWWWWWWMMMMM MM ",
" MM M MMMWWWWBBB WWWWMMM M M ",
" M MMM MWWWBBBBBB BBBWWM MMM ",
" MMMMMWW BBBBBYYYY BBBWWMMMMM ",
" M MMMWWB BBB YYYYBBBWWMMM ",
" MM MWWWBB B BBBYYYB WWWM M ",
" MMM WWBBBB BBBBBYYY WW MM ",
" MM MWWBBBBB BBBBBBBYY BWWM M ",
" M MWWBBBBB BBBBB Y BWWM ",
" MMWW BBB B BBB Y WWMM ",
" M MWW B BBB B BBB WWM ",
" MM WW BBBBB BBBBB WW M ",
" MMMWWB OBBBBBBB BBBBBBBWWMM ",
" MM WW O BBBBB BBBBB WW M ",
" M MWW BOO BBB B BBB WWM ",
" MMMWWBBOOO B BBB B WWMMM ",
" M MMWWBBBOOO BBBBB WWMM ",
" MM MWWWBBBOOO BBBBBBB WWWM M ",
" MMM MWWBBB OOOOBBBBB BWWM MM ",
" MM M MWWB BOOOOBB BWWM M M ",
" M MMM MWWWWBBB B WWWM MMM ",
" MMMMM MWWWWBBB WWWWM MMMMM ",
" M MMM M MMWWWWWWWWWWWMM M MMM ",
" MM M MMM M MWWWWWWWM M MMM M M ",
" MMM MMMMM MMMMM MMMMM MMMMM MM ",
" MM M MMM M MMM M MMM M MMM M M ",
" M MMM M MMM M MMM M MMM M MMM ",
" ");
const proc: introduction is func
begin
setPos(win, 1, 1);
writeln(win, "S O K O B A N");
writeln(win);
writeln(win, "Copyright (C) 2008 Thomas Mertes");
writeln(win);
writeln(win, "This program is free software under the");
writeln(win, "terms of the GNU General Public License");
writeln(win);
writeln(win, "Sokoban is written in the Seed7");
writeln(win, "programming language");
writeln(win);
writeln(win, "Homepage: http://seed7.sourceforge.net");
setPos(win, 20, 1);
writeln(win, "The following commands are accepted:");
writeln(win, " cursor keys to move");
writeln(win, " u to undo a move");
writeln(win, " r to redo a move which was undone");
writeln(win, " q to quit the game");
writeln(win, " n for next level");
writeln(win, " p for previous level");
writeln(win, " s to restart current level");
writeln(win, " l to select other level");
end func;
const func PRIMITIVE_WINDOW: createButton (in array string: picture,
in string: name, in integer: xPos, in integer: yPos) is func
result
var PRIMITIVE_WINDOW: button is PRIMITIVE_WINDOW.value;
local
var text: fontFile is STD_NULL;
begin
button := openSubWindow(curr_win, xPos, yPos, 96, 32);
drawPattern(button, 0, 0, picture, 1, black);
fontFile := openPixmapFontFile(button);
setFont(fontFile, stdFont9);
color(fontFile, white, black);
setPosXY(fontFile, 45, 18);
write(fontFile, name);
end func;
const proc: loadPixmaps is func
begin
player_pixmap := createPixmap(player_pic, 1, black);
goal_pixmap := createPixmap(goal_pic, 1, black);
wall_pixmap := createPixmap(wall_pic, 1, black);
packet_pixmap := createPixmap(packet_pic, 1, black);
player_at_goal_pixmap := createPixmap(player_at_goal_pic, 1, black);
packet_at_goal_pixmap := createPixmap(packet_at_goal_pic, 1, black);
undo_button := createButton(undo_pic, "undo", 650, 412);
redo_button := createButton(redo_pic, "redo", 650, 448);
quit_button := createButton(exit_pic, "quit", 650, 484);
next_button := createButton(next_pic, "next", 750, 412);
previous_button := createButton(previous_pic, "previous", 750, 448);
restart_button := createButton(reset_pic, "restart", 750, 484);
end func;
const proc: readLevel (inout char: keyChar) is func
local
var string: numberStri is "";
var integer: newLevel is 0;
var boolean: okay is FALSE;
var integer: tries is 0;
begin
setPos(win, 13, 1);
write(win, "Indicate which level to play (1-" <& length(levels) <& ") ");
repeat
incr(tries);
setPos(win, 14, 1);
write(win, " " mult 64);
setPos(win, 14, 1);
write(win, "Level = ");
readln(numberStri);
if IN.bufferChar = KEY_CLOSE then
keyChar := KEY_CLOSE;
elsif numberStri <> "" then
block
newLevel := integer(numberStri);
if newLevel >= 1 and newLevel <= length(levels) then
levelNumber := newLevel;
okay := TRUE;
else
raise RANGE_ERROR;
end if;
exception
catch RANGE_ERROR:
setPos(win, 13, 1);
write(win, "This is not a correct level. Try again (1-" <&
length(levels) <& ") ");
end block;
end if;
until okay or numberStri = "" or tries >= 2 or keyChar = KEY_CLOSE;
end func;
const proc: recognizeFieldsOutside (in integer: line, in integer: column) is func
begin
if levelMap[line][column].fieldCategory = GROUND then
levelMap[line][column].fieldCategory := OUTSIDE;
if line > 1 then
recognizeFieldsOutside(pred(line), column);
end if;
if line < length(levelMap) then
recognizeFieldsOutside(succ(line), column);
end if;
if column > 1 then
recognizeFieldsOutside(line, pred(column));
end if;
if column < length(levelMap[line]) then
recognizeFieldsOutside(line, succ(column));
end if;
end if;
end func;
const proc: recognizeFieldsOutside is func
local
var integer: line is 0;
var integer: column is 0;
begin
if length(levelMap) >= 1 then
for column range 1 to length(levelMap[1]) do
recognizeFieldsOutside(1, column);
recognizeFieldsOutside(length(levelMap), column);
end for;
end if;
for line range 1 to length(levelMap) do
if length(levelMap[line]) >= 1 then
recognizeFieldsOutside(line, 1);
recognizeFieldsOutside(line, length(levelMap[line]));
end if;
end for;
end func;
const proc: generateLevelMap (in array string: levelData) is func
local
var integer: line is 0;
var integer: column is 0;
var fieldType: currField is fieldType.value;
begin
numberOfMoves := 0;
numberOfPushes := 0;
levelMap := length(levelData) times length(levelData[1]) times fieldType.value;
numberOfPackets := 0;
savedPackets := 0;
xPos := -1;
yPos := -1;
for line range 1 to length(levelData) do
for column range 1 to length(levelData[line]) do
currField := fieldType.value;
case levelData[line][column] of
when {'#'}:
currField.fieldCategory := WALL;
when {' '}:
currField.fieldCategory := GROUND;
when {'.'}:
currField.fieldCategory := GROUND;
currField.isGoalField := TRUE;
when {'@'}:
currField.fieldCategory := PLAYER;
yPos := line;
xPos := column;
when {'+'}:
currField.fieldCategory := PLAYER;
currField.isGoalField := TRUE;
yPos := line;
xPos := column;
when {'$'}:
currField.fieldCategory := PACKET;
incr(numberOfPackets);
when {'*'}:
currField.fieldCategory := PACKET;
currField.isGoalField := TRUE;
incr(savedPackets);
incr(numberOfPackets);
end case;
levelMap[line][column] := currField;
end for;
end for;
recognizeFieldsOutside;
end func;
const proc: readLevelMap (in integer: levelNumber) is func
begin
generateLevelMap(levels[levelNumber]);
end func;
const proc: writeStatus is func
begin
setPos(win, 14, 1);
writeln(win, "Level = " <& levelNumber);
writeln(win, "Packets = " <& numberOfPackets);
writeln(win, "Saved Packets = " <& savedPackets <& " ");
writeln(win, "Movements = " <& numberOfMoves <& " ");
writeln(win, "Pushes = " <& numberOfPushes <& " ");
end func;
const proc: drawMap is func
local
var integer: line is 0;
var integer: column is 0;
var PRIMITIVE_WINDOW: sprite is PRIMITIVE_WINDOW.value;
begin
for line range 1 to length(levelMap) do
for column range 1 to length(levelMap[line]) do
if levelMap[line][column].dirty then
case levelMap[line][column].fieldCategory of
when {WALL}:
sprite := wall_pixmap;
when {GROUND}:
if levelMap[line][column].isGoalField then
sprite := goal_pixmap;
else
rect(pred(column) * TILE_SIZE, pred(line) * TILE_SIZE,
TILE_SIZE, TILE_SIZE, brown);
sprite := PRIMITIVE_WINDOW.value;
end if;
when {PLAYER}:
if levelMap[line][column].isGoalField then
sprite := player_at_goal_pixmap;
else
sprite := player_pixmap;
end if;
when {PACKET}:
if levelMap[line][column].isGoalField then
sprite := packet_at_goal_pixmap;
else
sprite := packet_pixmap;
end if;
otherwise:
rect(pred(column) * TILE_SIZE, pred(line) * TILE_SIZE,
TILE_SIZE, TILE_SIZE, black);
sprite := PRIMITIVE_WINDOW.value;
end case;
if sprite <> PRIMITIVE_WINDOW.value then
put(curr_win, pred(column) * TILE_SIZE,
pred(line) * TILE_SIZE, sprite);
end if;
levelMap[line][column].dirty := FALSE;
end if;
end for;
end for;
end func;
const proc: assignDxDy (in moveType: move,
inout integer: dx, inout integer: dy) is func
begin
dx := 0;
dy := 0;
case move.direction of
when {UP}:
dy := -1;
when {DOWN}:
dy := 1;
when {LEFT}:
dx := -1;
when {RIGHT}:
dx := 1;
end case;
end func;
const proc: moveDxDy (in integer: dx, in integer: dy,
inout fieldType: currField, inout fieldType: nextField) is func
begin
currField.fieldCategory := GROUND;
nextField.fieldCategory := PLAYER;
currField.dirty := TRUE;
nextField.dirty := TRUE;
xPos +:= dx;
yPos +:= dy;
end func;
const proc: pushDxDy (in integer: dx, in integer: dy,
inout fieldType: currField, inout fieldType: nextField,
inout fieldType: destField) is func
begin
currField.fieldCategory := GROUND;
nextField.fieldCategory := PLAYER;
destField.fieldCategory := PACKET;
currField.dirty := TRUE;
nextField.dirty := TRUE;
destField.dirty := TRUE;
xPos +:= dx;
yPos +:= dy;
if nextField.isGoalField then
if not destField.isGoalField then
decr(savedPackets);
end if;
else
if destField.isGoalField then
incr(savedPackets);
end if;
end if;
incr(numberOfPushes);
end func;
const proc: pullDxDy (in integer: dx, in integer: dy,
inout fieldType: currField, inout fieldType: nextField,
inout fieldType: packetField) is func
begin
currField.fieldCategory := PACKET;
nextField.fieldCategory := PLAYER;
packetField.fieldCategory := GROUND;
currField.dirty := TRUE;
nextField.dirty := TRUE;
packetField.dirty := TRUE;
xPos +:= dx;
yPos +:= dy;
if packetField.isGoalField then
if not currField.isGoalField then
decr(savedPackets);
end if;
else
if currField.isGoalField then
incr(savedPackets);
end if;
end if;
decr(numberOfPushes);
end func;
const proc: undoMove is func
local
var integer: dx is 0;
var integer: dy is 0;
var moveType: move is moveType.value;
begin
if moveNumber >= 1 then
move := playerMoves[moveNumber];
assignDxDy(move, dx, dy);
if move.mode = MOVE then
moveDxDy(-dx, -dy,
levelMap[yPos][xPos],
levelMap[yPos - dy][xPos - dx]);
decr(numberOfMoves);
else
pullDxDy(-dx, -dy,
levelMap[yPos][xPos],
levelMap[yPos - dy][xPos - dx],
levelMap[yPos + dy][xPos + dx]);
end if;
decr(moveNumber);
end if;
end func;
const proc: redoMove is func
local
var integer: dx is 0;
var integer: dy is 0;
var moveType: move is moveType.value;
begin
if moveNumber < length(playerMoves) then
incr(moveNumber);
move := playerMoves[moveNumber];
assignDxDy(move, dx, dy);
if move.mode = MOVE then
moveDxDy(dx, dy,
levelMap[yPos][xPos],
levelMap[yPos + dy][xPos + dx]);
incr(numberOfMoves);
else
pushDxDy(dx, dy,
levelMap[yPos][xPos],
levelMap[yPos + dy][xPos + dx],
levelMap[yPos + 2 * dy][xPos + 2 * dx]);
end if;
end if;
end func;
const func boolean: doMove (inout moveType: move, in moveDirection: direction,
in integer: dx, in integer: dy) is func
result
var boolean: didMove is FALSE;
begin
move.direction := direction;
case levelMap[yPos + dy][xPos + dx].fieldCategory of
when {GROUND}:
moveDxDy(dx, dy,
levelMap[yPos][xPos],
levelMap[yPos + dy][xPos + dx]);
incr(numberOfMoves);
move.mode := MOVE;
if length(playerMoves) > moveNumber then
playerMoves := playerMoves[.. moveNumber];
end if;
playerMoves &:= [] (move);
incr(moveNumber);
didMove := TRUE;
when {PACKET}:
if levelMap[yPos + 2 * dy][xPos + 2 * dx].fieldCategory = GROUND then
pushDxDy(dx, dy,
levelMap[yPos][xPos],
levelMap[yPos + dy][xPos + dx],
levelMap[yPos + 2 * dy][xPos + 2 * dx]);
move.mode := PUSH;
if length(playerMoves) > moveNumber then
playerMoves := playerMoves[.. moveNumber];
end if;
playerMoves &:= [] (move);
incr(moveNumber);
didMove := TRUE;
end if;
end case;
end func;
const proc: doMove (inout moveType: move) is func
local
var integer: clickedX is 0;
var integer: clickedY is 0;
var integer: playerX is 0;
var integer: playerY is 0;
var boolean: didMove is FALSE;
var time: curr_time is time.value;
begin
clickedX := clickedXPos(KEYBOARD);
clickedY := clickedYPos(KEYBOARD);
repeat
curr_time := time(NOW);
playerX := pred(xPos) * TILE_SIZE + width(player_pixmap) div 2;
playerY := pred(yPos) * TILE_SIZE + height(player_pixmap) div 2;
if abs(clickedX - playerX) > width(player_pixmap) div 2 or
abs(clickedY - playerY) > height(player_pixmap) div 2 then
if abs(clickedX - playerX) > abs(clickedY - playerY) then
if clickedX > playerX then
didMove := doMove(move, RIGHT, 1, 0);
else
didMove := doMove(move, LEFT, -1, 0);
end if;
else
if clickedY > playerY then
didMove := doMove(move, DOWN, 0, 1);
else
didMove := doMove(move, UP, 0, -1);
end if;
end if;
writeStatus;
drawMap;
if didMove then
flushGraphic;
await(curr_time + 100000 . MICRO_SECONDS);
end if;
else
didMove := FALSE;
end if;
until not didMove;
end func;
const proc: playLevel is func
local
var integer: line is 0;
var integer: column is 0;
var boolean: levelFinished is FALSE;
var moveType: move is moveType.value;
begin
playerMoves := 0 times moveType.value;
moveNumber := 0;
clear(black);
introduction;
writeStatus;
drawMap;
repeat
keyChar := getc(KEYBOARD);
case keyChar of
when {KEY_UP}:
ignore(doMove(move, UP, 0, -1));
writeStatus;
when {KEY_DOWN}:
ignore(doMove(move, DOWN, 0, 1));
writeStatus;
when {KEY_LEFT}:
ignore(doMove(move, LEFT, -1, 0));
writeStatus;
when {KEY_RIGHT}:
ignore(doMove(move, RIGHT, 1, 0));
writeStatus;
when {KEY_MOUSE1}:
if buttonWindow(KEYBOARD) = curr_win then
doMove(move);
elsif buttonWindow(KEYBOARD) = undo_button then
keyChar := 'u';
elsif buttonWindow(KEYBOARD) = redo_button then
keyChar := 'r';
elsif buttonWindow(KEYBOARD) = quit_button then
keyChar := 'q';
elsif buttonWindow(KEYBOARD) = next_button then
keyChar := 'n';
elsif buttonWindow(KEYBOARD) = previous_button then
keyChar := 'p';
elsif buttonWindow(KEYBOARD) = restart_button then
keyChar := 's';
end if;
end case;
drawMap;
if keyChar = 'q' or keyChar = KEY_CLOSE then
levelFinished := TRUE;
elsif keyChar = 'u' then
if savedPackets = numberOfPackets then
setPos(win, 13, 1);
erase(win, "***** C O N G R A T U L A T I O N *****");
writeln(win);
writeln(win);
erase(win, " The level " <& levelNumber <& " is solved");
end if;
undoMove;
writeStatus;
drawMap;
elsif keyChar = 'r' then
redoMove;
writeStatus;
drawMap;
elsif keyChar = 's' then
levelFinished := TRUE;
elsif keyChar = 'l' then
readLevel(keyChar);
levelFinished := TRUE;
elsif keyChar = 'n' then
while levelNumber < length(levels) and keyChar = 'n' do
incr(levelNumber);
levelFinished := TRUE;
keyChar := getc(KEYBOARD, NO_WAIT);
end while;
elsif keyChar = 'p' then
while levelNumber > 1 and keyChar = 'p' do
decr(levelNumber);
levelFinished := TRUE;
keyChar := getc(KEYBOARD, NO_WAIT);
end while;
elsif keyChar = KEY_ESC then
bossMode(levelFinished);
if levelFinished then
keyChar := 'q';
end if;
end if;
if savedPackets = numberOfPackets then
setPos(win, 13, 1);
writeln(win, "***** C O N G R A T U L A T I O N *****");
writeln(win, " " mult 64);
writeln(win, " The level " <& levelNumber <& " is solved");
write(win, " " mult 64);
end if;
until levelFinished;
while inputReady(KEYBOARD) do
ignore(getc(KEYBOARD));
end while;
end func;
const proc: main is func
begin
screen(992, 544);
selectInput(curr_win, KEY_CLOSE, TRUE);
KEYBOARD := GRAPH_KEYBOARD;
win := openPixmapFontFile(curr_win, 650, 4);
setFont(win, stdFont9);
color(win, white, black);
IN := openEditLine(KEYBOARD, win);
loadPixmaps;
clear(black);
repeat
readLevelMap(levelNumber);
playLevel;
until keyChar = 'q' or keyChar = KEY_CLOSE;
end func;