
(********************************************************************)
(*                                                                  *)
(*  sokoban.sd7   Sokoban puzzle game                               *)
(*  Copyright (C) 2008  Thomas Mertes                               *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "float.s7i";
  include "text.s7i";
  include "draw.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 "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;


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 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);
  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, 30, 1);
    write(win, "Indicate which level to play (1-" <& length(levels) <& ") ");
    repeat
      incr(tries);
      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:
            write(win, "This is not a correct level. Try again ");
        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, PSET);
          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 proc: playLevel is func
  local
    var integer: dx is 0;
    var integer: dy is 0;
    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
      dx := 0;
      dy := 0;
      keyChar := getc(KEYBOARD);
      case keyChar of
        when {KEY_UP}:
          move.direction := UP;
          dy := -1;
        when {KEY_DOWN}:
          move.direction := DOWN;
          dy :=  1;
        when {KEY_LEFT}:
          move.direction := LEFT;
          dx := -1;
        when {KEY_RIGHT}:
          move.direction := RIGHT;
          dx :=  1;
      end case;
      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);
        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);
          end if;
      end case;
      writeStatus;
      drawMap;
      if keyChar = 'q' or keyChar = KEY_CLOSE then
        levelFinished := TRUE;
      elsif keyChar = 'u' then
        if savedPackets = numberOfPackets then
          setPos(win, 31, 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 is solved");
          writeln(win);
          writeln(win);
          erase(win,   "Press n for the next level ");
        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 := busy_getc(KEYBOARD);
        end while;
      elsif keyChar = 'p' then
        while levelNumber > 1 and keyChar = 'p' do
          decr(levelNumber);
          levelFinished := TRUE;
          keyChar := busy_getc(KEYBOARD);
        end while;
      elsif keyChar = KEY_ESC then
        bossMode(levelFinished);
        if levelFinished then
          keyChar := 'q';
        end if;
      end if;
      if savedPackets = numberOfPackets then
        setPos(win, 31, 1);
        writeln(win, "C O N G R A T U L A T I O N");
        writeln(win);
        writeln(win, "    The level is solved");
        writeln(win);
        write(win,   "Press n for the next level ");
      end if;
    until levelFinished;
    while keypressed(KEYBOARD) do
      ignore(getc(KEYBOARD));
    end while;
  end func;


const proc: main is func
  begin
    screen(992, 544);
    setCloseAction(curr_win, RETURN_KEY);
    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;
