program mebel;
uses Crt, Graph; {подключение дополнительных модулей}

type TPole = array[1..3,1..2] of Integer; {определяем тип - поле}
{поле для игры}
var pole: TPole;  {поле  игры, где 0 -пустая клетка,}
                                  {1-стоит шкаф,}
                                  {2-стоит кресло,}
                                  {3-стоит стоит стул 1}
                                  {4-стоит стоит стул 2}
                                  {5-стоит стоит стол}


  grDriver: Integer;
  grMode: Integer;
  ErrCode: Integer;
  Xs,Ys, {первоначальные координаты кресла шкафа}
  Xk,Yk, {первоначальные координаты кресла кресла}
  Flag_R:integer; {флаг расстановки на поле, мебели}

{процедура очистки экрана}
{procedure Clr;
begin
 SetFillStyle(0,0);
 Bar(0,0,GetMaxX,GetMaxY);
end; {proc Clr;}

{вывод подсказки в левом верхнем углу экрана}
procedure Help;
begin
 SetTextStyle(0,0,0);
 SetColor(3);
 Rectangle(10,10,163,180);
 OutTextXY(15,15,'Upravlenie');
 OutTextXY(15,30,'  - Peredvijenie');
 OutTextXY(15,45,'"Probel" - Hod');
 OutTextXY(15,60,'"ESC" - Vihod');
 SetFillStyle(1,4);
 Bar(15,75,15+30,75+30);
 OutTextXY(50,87,'-Shkaf');
 SetFillStyle(1,5);
 Bar(15,110,15+30,110+30);
 OutTextXY(50,122,'-Kreslo');
 SetFillStyle(1,6);
 Bar(15,145,15+30,145+30);
 OutTextXY(50,157,'-Stol ili Stul');

end; {proc Help2}

{процедура инициализации поля}
procedure Init (var Pole: TPole);
var X, Y: Integer;
begin
  for X := 1 to 3 do
    for Y := 1 to 2 do
      Pole[X,Y] := 0;
  Flag_R:=0;
end; {proc Init}

{функция проверки, можно ли двигать эту мебель}
function Prover(Pole:TPole;x,y:integer):boolean;
var
flag:boolean;
begin
 flag:=false;
 if (x=1) and (y=1) and ((Pole[x,y+1]=0) or (Pole[x+1,y]=0)) then flag:=true;

 if (x=2) and (y=1) and ((Pole[x-1,y]=0) or (Pole[x,y+1]=0) or (Pole[x+1,y]=0) ) then flag:=true;

 if (x=3) and (y=1) and ((Pole[x-1,y]=0) or (Pole[x,y+1]=0)) then flag:=true;


 if (x=1) and (y=2) and ((Pole[x,y-1]=0) or (Pole[x+1,y]=0)) then flag:=true;

 if (x=2) and (y=2) and ((Pole[x-1,y]=0) or (Pole[x,y-1]=0) or (Pole[x+1,y]=0)) then flag:=true;

 if (x=3) and (y=2) and ((Pole[x-1,y]=0) or (Pole[x,y-1]=0)) then flag:=true;

 Prover:=flag;
end;

{процедура прорисовки поля игры}
procedure Proris_pole(Pole: TPole);
var i,j,X,Y:integer;
begin
{ Clr;}
 SetColor(1);
 {рисуем поле}
 j:=75;
 {вертикальные полосы}
 for i:=1 to 4 do
  begin
   Line(GetMaxX div 2-j,GetMaxY div 2-50,GetMaxX div 2-j,GetMaxY div 2+50);
   j:=j-50;
 end;
 {горизонтальные линии}
 j:=50;
 for i:=1 to 3 do
  begin
   Line(GetMaxX div 2-75,GetMaxY div 2-j,GetMaxX div 2+75,GetMaxY div 2-j);
   j:=j-50;
 end;
{рисуем мебель}
 i:=GetMaxX div 2-65;
 for X := 1 to 3 do
  begin
   j:=GetMaxY div 2-40;
   for Y := 1 to 2 do
    begin
     case Pole[X,Y] of
       0: SetFillStyle(1,0);
       1: SetFillStyle(1,4);
       2: SetFillStyle(1,5);
       3: SetFillStyle(1,6);
       4: SetFillStyle(1,6);
       5: SetFillStyle(1,6);
      end;
     Bar(i,j,i+30,j+30);
     j:=j+50;
    end;
    i:=i+50;
   end;
{ readkey;}
end; {proc Proris_pole}

{процедура прорисовки курсора в игре}
procedure Kursor;
var
 xx,yy, { координаты ячейки с нулём}
 ii,jj, {счетчики цикла}
 x,y,      {координаты курсора}
 i,j:integer;    {координаты для прорисовки на экране}
 c:char;
 flag:boolean;
begin
 x:=1;y:=1;
 i:=GetMaxX div 2-65;
 j:=GetMaxY div 2-40;
 SetColor(11);
 Rectangle(i,j,i+30,j+30);
 flag:=true;
 while(flag) do
  begin
    c:=readkey;
    case c of
     #75:         {влево}
        if(x-1>0) then
         begin
           i:=i-50;
           x:=x-1;
           Proris_pole(pole);
           SetColor(11);
           Rectangle(i,j,i+30,j+30);
          end;
     #77:         {вправо}
        if(x+1<4) then
         begin
           i:=i+50;
           x:=x+1;
           Proris_pole(pole);
           SetColor(11);
           Rectangle(i,j,i+30,j+30);
          end;
     #72:         {вверх}
        if(y-1>0) then
            begin
             j:=j-50;
             y:=y-1;
             Proris_pole(pole);
             SetColor(11);
             Rectangle(i,j,i+30,j+30);
            end;
     #80:         {вниз}
        if(y+1<3) then
          begin
           j:=j+50;
           y:=y+1;
           Proris_pole(pole);
           SetColor(11);
           Rectangle(i,j,i+30,j+30);
          end;
     #32:  {пробел}
        begin
         if(pole[x,y]=0) and (Flag_R<5)then {расстановка на игровом поле меели}
          begin
           inc(Flag_R);
           if(Flag_R=1) then {если поставили шкаф, то запоминаем его координаты}
            begin
             Xs:=x;
             Ys:=y;
            end;
           if(Flag_R=2) then {если поставили кресло, то запоминаем его координаты}
            begin
             Xk:=x;
             Yk:=y;
            end;
           pole[x,y]:=Flag_R;
           Proris_pole(pole);
           SetColor(11);
           Rectangle(i,j,i+30,j+30);
          end
         else
          if(Prover(pole,x,y)) then
           begin
             for ii := 1 to 3 do
              for jj := 1 to 2 do
               if pole[ii,jj] = 0 then
                  begin
                   xx:=ii;
                   yy:=jj;
                  end;
             ii:=pole[xx,yy];
             pole[xx,yy]:=pole[x,y];
             pole[x,y]:=ii;
             Proris_pole(pole);
             SetColor(11);
             Rectangle(i,j,i+30,j+30);
             if(pole[Xs,Ys]=2)and(pole[Xk,Yk]=1)then
              begin
               flag:=false;

              end;
           end;
        end;
     #27:begin
           flag:=false;         {выход}
         end;
    end; {end case}
  end;{end while}
 OutTextXY(GetMaxX div 2-100,GetMaxY div 2+120,'GAME OVER!!!');
end; {proc Kursor}



begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,'egavga.bgi');
  ErrCode := GraphResult;
  if ErrCode = grOk then
  begin  { Do graphics }
    Init(pole);
    Help;
    Proris_pole(pole);
    Kursor;
    Readkey;
    CloseGraph;
  end
  else
    Writeln('Ошибка инициализации нрафического режима:', GraphErrorMsg(ErrCode));
end.