Sokoban for Turbo Pascal

Here is the simple ASCII text graphics version of Sokoban game for Turbo Pascal.

Controls:

  • w, s, a, d – UP, DOWN, LEFT, RIGHT
  • ESC – exit

Map file example for input:

MAP.TXT
17 10
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
1 0 0 0 2 0 0 0 0 0 2 0 2 0 4 0 1
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1 0 3 0 0 1 0 0 0 1
0 0 0 0 0 0 0 1 0 3 0 0 0 0 0 1 1
0 0 0 0 0 0 0 1 0 3 0 0 0 0 0 1 1
0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 1
0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1
program sokoban;
uses crt;
type
 sPoint = record
  x:integer;
  y:integer;
 end; { structure type for map point }
 
const
 mxWidth = 100;
 mxHeight = 100; { max width and height of field }
 
 maxBlocks = 100; { max count of blocks }
 
var
 map: array [1..mxWidth, 1..mxHeight] of byte; { map }
 fin: Text; { map file }
 i,j:integer; { counters}
 v:byte; { sokoban player direction }
 m,n: integer; { windth and height of player map } 
 freesq,  { количесво свободных "контейнеров" для ящиков}
 countsq: integer; { количесво ящиков }
 c: char; { код клавиатуры }
 player: sPoint; { координаты игрока}
 nx, ny:integer; { временные переменные для хранения следующей позиции игрока}
 blockpoint: array [1..maxBlocks] of sPoint; { массив ящиков }
 lastpx, lastpy, lastbx, lastby, lastbi, lastc: integer; { временные переменные сохраняющие предпоследнюю позицию игрока }
 f: Boolean;  { флаг совершения хода, чтобы нельзя было отменить ход в самом начале игры }
 
{ возвращает идентификатор (номер) блока расположенного по координатам x,y, если блока нет, возвращает 0} 
function get_block(x,y:integer): integer;
var
 i:integer;
 v: integer;
begin
 v:=0;
 for i:=1 to countsq do { просматриваем массив блоков }
  if (blockpoint[i].x = x) and (blockpoint[i].y = y) then
  begin
   v := i;
   break; { если нашли, то прерываем работу цикла посика }
  end;
 get_block:=v;
end;
 
{пытаеться переместить блок, ели его толкает сокобан, если удалось возвращает значение Истина, иначе Ложь}
function TryMoveBlock(id:integer):Boolean;
var
 nx,ny,x,y:integer;
begin
 x:= blockpoint[id].x;
 y:= blockpoint[id].y; {запоминаем текущие координаты блока}

 lastbx:=x;
 lastby:=y;
 lastbi:=id;
 lastc := freesq; {сохраняем параметры блока, для восстановления если пользовател отменит последний ход}

 case v of {определяем направление движения сокобана, чтобы в этом же направлении сдвинуть блок}
 1: begin nx:=x; ny:=y-1; end; {вверх}
 2: begin nx:=x; ny:=y+1; end; {вниз}
 3: begin nx:=x-1; ny:=y; end; {влево}
 4: begin nx:=x+1; ny:=y; end; {вправо}
 end;

 if (get_block(nx,ny) = 0) and (map[ny,nx] <>1) then  {если дальше нет стены, или второго блока, то двигаем блок}
 begin

      blockpoint[id].x := nx;
      blockpoint[id].y := ny;
      if (map[ny,nx] = 3) and (map[y,x] = 0) then {если блок передвинут с пустой клетки, то уменьшаем счетчик свободных контейнеров}
      begin
         dec( freesq );
      end
      else if (map[ny,nx] = 0) and (map[y,x] = 3) then {иначе если блок передвинут с фыинального места на пустое, возвращаем значения счетчика}
         inc( freesq );

      TryMoveBlock := True;
      exit;
 end;
 TryMoveBlock := False;

end;

{пытаеться переместить сокобана на новые координаты если это возможно}
procedure MoveSokoban(x,y:integer);
var
 bi:integer; {идентификатор блока}
begin
     lastpx:=player.x;
     lastpy:=player.y; { запоминаем позицию сокобана, для последующего восстановления предыдущего хода, если потребуеться}

	 {определяем границы возможного перемещения}
     if ( x>0) and (y>0) and (x<m) and (y<m) then
     if map[y,x] <> 1 then begin {если впереди не стенка}
        bi  := get_block(x,y); { узнаем, есть ли там блок }
        if bi > 0 then {если есть }
        begin
           if (TryMoveBlock(bi)) then {то сначало пробуем переместить блок, а если удалось - перемещаем вслед сокобана}
           begin
                   player.x := x;
                   player.y := y;
           end;
        end
        else {если блока и стены нет, то просто перемещаем сокобана}
         begin
                   player.x := x;
                   player.y := y;
         end;
     end;
end;
begin
 freesq := 1;
 countsq := 0;
 Assign(fin, 'Map.txt');
 Reset(fin); {открываем файл карты}
 Read(fin,m,n); {считываем размеры карты}
 for i :=1 to n do
  for j := 1 to m do
  begin { считываем саму карту }
   Read(fin, v);

   case v of
    1: map[i,j] := 1; {стена}
	  2: map[i,j] := 3; {"контейнер" для ящиков}
    3: begin blockpoint[freesq].x := j; blockpoint[freesq].y := i; inc(freesq);  inc(countsq); end; {блок}
    4: begin player.x := j; player.y := i; end; {игрок}
	else
	 map[i,j] := 0; {пустая клетка}
   end;
  end;
  Close(fin); {закрываем файл карты}
  lastc := freesq;
  f:=False; {запоминаем условия отмены хода}
 while(freesq > 1) do {пока хоть один контейнер свободен}
 begin
   clrscr; {очищаем экран}

   for i:=1 to n do
   begin
    for j:=1 to m do
    begin {отображаем карту}
     gotoxy(j,i);
     TextColor(14);
     if (map[i,j] = 1) then
      write('І')
     else if (map[i,j] = 3) then
      begin
        TextColor(2);
        write('Ь');
      end

     else
      write(' ');
    end;

    writeln;
   end;

   for i:=1 to countsq do
   begin {отображаем блоки}
        gotoxy( blockpoint[i].x , blockpoint[i].y);
        TextColor(5);
        write('Ы');
   end;

   TextColor(14);
   gotoxy(player.x, player.y);
   write(''); {отображаем игрока}

   gotoxy(80,25); {убираем курсор, чтобы не мозолил глаз}
   c := ReadKey;
   case c of {проверяем ввод с клавиатуры}
   'w': begin nx:=player.x; ny:=player.y-1; v:=1; end; {ход вверх}
   's': begin nx:=player.x; ny:=player.y+1; v:=2; end; {ход вниз}
   'a': begin nx:=player.x-1; ny:=player.y; v:=3; end; {ход влево}
   'd': begin nx:=player.x+1; ny:=player.y; v:=4; end; {ход вправо}

   'z': if f then begin
             freesq := lastc;
             player.x := lastpx;
             player.y := lastpy;

             blockpoint[lastbi].x := lastbx;
             blockpoint[lastbi].y := lastby;
             continue;
   end;
   #27: break; {выход }
   end;
   f:=True;
   MoveSokoban(nx,ny); {пытаемся переместить сокобан}
 end;
 clrscr;
 textcolor(15);

 if (freesq = 1) then {сообщаем пользователю о выйгрыше если ему удалось заполнить все контейнеры}
  writeln('You Win!')
 else {или о проигрыше если , он самостоятельно прервал игру}
  writeln('You Lose!');
 writeln('Press Enter for exit!');
 readln;
end.

Snake for Turbo Pascal

Snake is another ASCII graphics game example for Turbo Pascal additionally to Sokoban.

program  csnake;
uses crt;
type
 sPoint = record
  x:integer;
  y:integer;
 end; {тип для точки} 
const
 maxWidth = 40; {максимальна длинна змейки} 
var
 width: integer; {длина змейки}
 e :sPoint; {координаты еды} 
 snakebody: array [1..maxWidth] of sPoint; {массив с координатами частей тела змейки} 
 i, {считчик цикла} 
	nx, ny:integer {координаты головы змейки} ; 
 v: byte; {вектор направления головы змейки} 
 gameover: boolean; {флаг окончания игры} 
 key: char; {буфер клавиши} 

 {проверяет свободна ли клетка и не выходит ли она за границы поля} 
function CheckNext(x:integer; y:integer):boolean;
var
 isset: Boolean; {флаг проверки занятости клетки или выхода за границы поля} 
 i: integer;
begin
  isset := True;
  for i:=1 to width do
  begin {проверяем нет ли на места клетки змейки} 
   if (x = snakebody[i].x) and ( y = snakebody[i].y ) then
      isset := False;
  end;
  if isset then
  begin {проверяем не вышла ли голова змейки за границы поля} 
   if (x <= 0) or (y<=0) or (x>=80) or (y>=25) then isset := False;
  end;
  CheckNext := isset;
end;

{создает еду на поле} 
procedure NewEat;
begin
 e.x := random(78) + 2;
 e.y := random(23) + 2; {генерируем координаты еды} 

 {если место занято, генерируем еще раз, и так пока не найдем свободное} 
 while (not CheckNext(e.x, e.y)) do
 begin
  e.x := random(78) + 2;
  e.y := random(23) + 2;
 end;
end;

{перемещает змейку}
procedure MoveSnake(x,y:integer);
var
 i:integer; {счетчик цикла} 
begin
 for i:=1 to width do
 begin
  snakebody[i] := snakebody[i+1]; 
 end; {перещаем все состовляющие змеки, на место соседнего} 
 
 snakebody[width].x := x;
 snakebody[width].y := y; {голове змейки присваиваем новые координаты} 
 
 if (x = e.x) and (y = e.y) then {если голова нашла еду} 
 begin
  width := width + 1; {добавляем еще 1 клетку к змейке} 
  snakebody[width].x := x;
  snakebody[width].y := y;
  NewEat; {создаем новую еду} 
 end;
end;

begin
 gameover := false;
 {выстраиваем начальное тело змейки} 
 width := 4;

 snakebody[1].x := 1;
 snakebody[1].y := 1;

 snakebody[2].x := 2;
 snakebody[2].y := 1;

 snakebody[3].x := 3;
 snakebody[3].y := 1;

 snakebody[4].x := 4;
 snakebody[4].y := 1;

 clrscr;
 v  := 1;

 Randomize;

 NewEat; {создаем еду} 

 while(width < maxWidth) do {пока длина змейки меньше заданной} 
 begin

   if (KeyPressed) then {если была нажата клавиша} 
   begin
     key:=Readkey; {считываем её} 
     case key of
      'w': begin if v = 4 then continue; v := 3;  end; {вверх}  
      's': begin if v = 3 then continue; v := 4;  end; {вниз} 	  
      'a': begin if v = 1 then continue; v := 2;  end; {влево} 
      'd': begin if v = 2 then continue; v := 1;  end; {впправо} 
      #27: break; {выход} 
     end;
   end;

   clrscr;

   {поеределение направления движения головы змейки}
   case v of
    1: begin nx := snakebody[width].x + 1;  ny := snakebody[width].y; end; {вправо}
    2: begin nx := snakebody[width].x - 1;  ny := snakebody[width].y; end; {влево}
    3: begin nx := snakebody[width].x;  ny := snakebody[width].y - 1; end; {вверх}
    4: begin nx := snakebody[width].x;  ny := snakebody[width].y + 1; end; {вниз}
   end;

   {если впереди граница или препятствие} 
   if (not CheckNext(nx,ny)) then
   begin
    gameover := true; {заканчиваем игру с поражением пользователя}
    break;
   end;

   MoveSnake(nx, ny); {перемещаем змейку} 

   gotoxy(e.x, e.y);
   write(''); {отображаем еду} 


   for i:=1 to width-1 do
    begin {отображаем тело змейки} 
     gotoxy(snakebody[i].x, snakebody[i].y);
     write('Ы');
    end; 
   gotoxy(snakebody[width].x, snakebody[width].y);
   write('+'); {отображение головы змейки} 

   gotoxy(80,25); {уводим курсор, чтобы не мешал} 

   Delay(30000); {задержка, для разных процессоров разная!}  
 end;

 clrscr;

 if (gameover) then {выводим сообщение пользователю о выйгрыше или проигрыше} 
  WriteLn('GAME OVER!')
 else
  WriteLn('YOU WIN!');

  WriteLn('Press Enter for exit!');
  readln;
end.