Сокобан/грузчик/ящики на PASCALABC.net

uses
  GraphABC;
  
const
  maxSize = 19;
  barSize = 60;
  Levels  = 2;
  sLevels : array [1..Levels] of String = (
    '19x11[....WWWWW][....W...W][....WB..W][..[url]WWW..BWW][/url][..W..B.B.W][[url]WWW.W.WW.W...WWWWWW][/url][W...W.WW.WWWWW..OOW][W.B..B..........OOW][WWWWW.[url]WWW.WSWW..OOW][/url][....W.....WWWWWWWWW][....WWWWWWW]',
    '14x10[WWWWWWWWWWWW][WOO..W.....WWW][WOO..W.B..B..W][WOO..WBWWWW..W][WOO....S.WW..W][WOO..W.W..B.WW][WWWWWW.WWB.B.W][..W.B..B.B.B.W][..W....W.....W][..WWWWWWWWWWWW]'
  );
  
type
  tLevel = record
    m : array [0..maxSize, 0..maxSize] of Byte; /// игровое поле
    w, h : Byte; /// размеры поля
    x, y : Byte; /// координаты грузчика
    b, s, c : Byte; /// число b-ящиков, s-мест, c-ящиков на местах
    Number, Steps : Integer; /// номер уровня и число шагов
  end;
 
var
  Level : tLevel;
 
procedure Caption;
begin
  Window.Caption := String.Format(' Socoban:    Level {0}.    Steps {1}.    Solved {2} in {3}.',
  Level.Number, Level.Steps, Level.c, Level.s);
end;
 
procedure ClearLevel;
begin
  with Level do
    begin
      w := 0; h := 0; x := 0; y := 0; b := 0; s := 0; c := 0; Steps := 0; Number := 0;
      for var Row := 0 to maxSize do for var Col := 0 to maxSize do m[Row, Col] := 0;
    end;
end;
 
procedure Parse(s : String);
begin
  var w := s.Substring(0, s.IndexOf('x')); s := s.Remove(0, w.Length+1);
  var h := s.Substring(0, s.IndexOf('[')); s := s.Remove(0, h.Length+1);
  Level.w := StrToInt(w); Level.h := StrToInt(h);
  var x := 0; var y := 0;
  repeat
    var c := s[1]; s := s.Remove(0, 1);
    case c of
      '.' : x += 1;
      'W' : { стена } begin Level.m[x, y] := 4; x += 1; end;
      'B' : { ящик } begin Level.m[x, y] := 2; x += 1; Level.b += 1; end;
      'O' : { место под ящик } begin Level.m[x, y] := 1; x += 1; Level.s += 1; end;
      'R' : { ящик на месте } begin Level.m[x, y] := 3; x += 1; Level.b += 1; Level.s += 1; Level.c += 1; end;
      'S' : { грузчик } begin Level.x := x; Level.y := y; x += 1; end;
      ']' : { конец строки } begin y += 1; x := 0; end;
    end;
  until (y > maxSize) or (s.Length = 0);
end;
 
procedure ShowLevel;
begin
  SetSmoothingOn;
  SetCoordinateOrigin(10, 10);
  
  with Level do
    begin
      for var Row := 0 to w-1 do
        for var Col := 0 to h-1 do
          begin
            case m[Row, Col] of
              0 : { пусто } begin Pen.Color := RGB(0,65,190); Brush.Color := RGB(0,65,100); end;
              1 : { место под ящик } begin Pen.Color := RGB(0,65,190); Brush.Color := RGB(0,65,190); end;
              2 : { ящик } begin Pen.Color := RGB(190,190,0); Brush.Color := RGB(190,190,0); end;
              3 : { ящик на месте } begin Pen.Color := RGB(255,255,255); Brush.Color := RGB(255,255,190); end;
              4 : { стена } begin Pen.Color := RGB(128,128,128); Brush.Color := RGB(128,128,128); end;
            end;
            RoundRect(Row * barSize, Col * barSize,
                      (Row + 1) * barSize - 2, (Col + 1) * barSize - 2,
                      6, 6);
          end;
          
      Pen.Color := RGB(210,210,0); Brush.Color := RGB(210,210,0);
      Ellipse(x * barSize + 2, y * barSize + 2,
              (x + 1) * barSize - 4, (y + 1) * barSize - 4);
    end;
  Caption;
  Redraw;
end;
 
procedure YouWin(Key : Integer);
begin
  Font.Color := RGB(Random(100, 256), Random(100, 256), Random(100, 256));
  Font.Size  := 100;
  Font.Name  := 'Times';
  DrawTextCentered(0, 0, Window.Width, Window.Height, 'You WIN!');
  Window.Caption := 'You WIN!';
  Redraw;
end;
  
procedure InitLevel(Next : Boolean);
begin
  var curLevelNumber := Level.Number + (Next ? 1 : 0);
  
  if curLevelNumber > Levels then
    begin
      onKeyDown := YouWin;
      Exit;
    end;
  
  ClearLevel;
  Parse(sLevels[curLevelNumber]);
  Level.Number := curLevelNumber;
  InitWindow( 20, 20, 20 + Level.w * barSize, 20 + Level.h * barSize, RGB(0,65,100) );
  ShowLevel;
end;
 
procedure Move(dX, dY : ShortInt);
begin
  var Row := Level.x + dX; var Col := Level.y + dY;
  case Level.m[Row, Col] of
    0, 1 : { пусто - двигаемся } begin Level.x := Row; Level.y := Col; Level.Steps += 1; end;
    2, 3 : { ящик }
      if Level.m[Row + dX, Col + dY] < 2 then { смотрим перед ним }
        { двигаемся и двигаем ящик }
        begin
          if Level.m[Row + dX, Col + dY] = 1 then Level.c += 1;
          if Level.m[Row, Col] = 3 then Level.c -= 1;
          Level.m[Row + dX, Col + dY] += 2;
          Level.m[Row, Col] -= 2;
          Level.x := Row; Level.y := Col;
          Level.Steps += 1;
        end;
  end;
  ShowLevel;
end;
 
procedure KeyDown(Key : Integer);
begin
  case Key of
    27 : { ESC - заново } InitLevel(False);
    37 : { влево  } Move(-1,  0);
    38 : { вверх  } Move( 0, -1);
    39 : { вправо } Move(+1,  0);
    40 : { вниз   } Move( 0, +1);
  end;
  
  if Level.s = Level.c then
    InitLevel(True);
end;
  
begin
  Window.IsFixedSize := True;
  onKeyDown := KeyDown;
  LockDrawing;
  Level.Number := 0; InitLevel(True);
end.