Program _2048_;
Uses Crt;
Var
  v,h,sc,won,i,eng,ent:integer;
  a:array[1..5,1..5] of integer;
  n,k:string;
label
  m1,endgame,r1,w1;
begin
writeln('Вводите W,A,S,D для передвижения блоков');
m1:
  randomize;
    h:=random(4)+1;
    v:=random(4)+1;
if a[h,v]=0 then
  a[h,v]:=2
else
  goto m1;
writeln('Счет:',sc);
for h:=1 to 4 do
  writeln(a[h,1],'  ',a[h,2],'  ',a[h,3],'  ',a[h,4]);
r1:
eng:=0;
repeat
  n:=readkey;
until (n='w') or (n='a') or (n='s') or (n='d');
clrscr;
if (n='w') then
begin
  for i:=1 to 2 do
  for h:=2 to 4 do
  for v:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h-1,v]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h-1,v]=0 then
        begin
          a[h-1,v]:=a[h,v];
          a[h,v]:=0;
        end;
  end;
  for h:=2 to 4 do
  for v:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h-1,v]<>a[h,v]) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h-1,v]=a[h,v] then
         begin
           a[h-1,v]:=a[h,v]*2;
           a[h,v]:=0;
           sc:=sc+a[h-1,v];
         end;
  end;
  for h:=2 to 4 do
  for v:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h-1,v]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h-1,v]=0 then
        begin
          a[h-1,v]:=a[h,v];
          a[h,v]:=0;
        end;
   end;
end;
if (n='s') then
begin
  for i:=1 to 2 do 
  for h:=3 downto 1 do
  for v:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h+1,v]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h+1,v]=0 then
        begin
          a[h+1,v]:=a[h,v];
          a[h,v]:=0;
        end;
  end;
  for h:=3 downto 1 do
  for v:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h+1,v]<>a[h,v]) then
      eng+=1;
    if a[h,v]<>0 then
     if a[h+1,v]=a[h,v] then
       begin
         a[h+1,v]:=a[h,v]*2;
         a[h,v]:=0;
         sc:=sc+a[h+1,v];
       end;
  end;
  for h:=3 downto 1 do
  for v:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h+1,v]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h+1,v]=0 then
        begin
          a[h+1,v]:=a[h,v];
          a[h,v]:=0;
        end;
   end;
end;
if (n='a') then
begin 
  for i:=1 to 2 do
  for v:=2 to 4 do
  for h:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h,v-1]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h,v-1]=0 then
        begin
          a[h,v-1]:=a[h,v];
          a[h,v]:=0;
        end;
  end;
  for v:=2 to 4 do
  for h:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h,v-1]<>a[h,v]) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h,v-1]=a[h,v] then
        begin
          a[h,v-1]:=a[h,v]*2;
          a[h,v]:=0;
          sc:=sc+a[h,v-1];
        end;
  end;
  for v:=2 to 4 do
  for h:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h,v-1]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h,v-1]=0 then
        begin
          a[h,v-1]:=a[h,v];
          a[h,v]:=0;
        end;
   end;
end;
if (n='d') then
begin
  for i:=1 to 2 do
  for v:=3 downto 1 do
  for h:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h,v+1]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h,v+1]=0 then
        begin
          a[h,v+1]:=a[h,v];
          a[h,v]:=0;
        end;
  end;
  for v:=3 downto 1 do
  for h:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h,v+1]<>a[h,v]) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h,v+1]=a[h,v] then
        begin
          a[h,v+1]:=a[h,v]*2;
          a[h,v]:=0;
          sc:=sc+a[h,v+1];
        end;
  end;
  for v:=3 downto 1 do
  for h:=1 to 4 do
  begin
    if (a[h,v]=0) or (a[h,v+1]<>0) then
      eng+=1;
    if a[h,v]<>0 then
      if a[h,v+1]=0 then
        begin
          a[h,v+1]:=a[h,v];
          a[h,v]:=0;
        end;
   end;
end;
  if eng=48 then
  begin
    writeln('Счет:',sc);
    for h:=1 to 4 do
      writeln(a[h,1],'  ',a[h,2],'  ',a[h,3],'  ',a[h,4]);
    i:=0;
    for h:=1 to 4 do
    for v:=1 to 4 do
      if a[h,v]=0 then
      i:=1;
    if i=0 then
      goto endgame
    else
      i:=0;
    goto r1;
  end
  else
    eng:=0;
for h:=1 to 4 do
for v:=1 to 4 do
  if (a[h,v]=2048) and (won=0) then
    begin
    writeln('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
    writeln('!!!!!!!!!!Вы Выиграли!!!!!!!!!!');
    writeln('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
    won:=1;
    end
  else
    if a[h,v]<>0 then
      ent+=1;
goto m1;
endgame:
  writeln('Вы Проиграли, ваш счет:',sc);
  writeln('Заново? Да + Нет - ');
  repeat
    k:=readkey;
  until (k='+') or (k='-');
  if k='+' then
    begin
      clrscr;
      for h:=1 to 4 do
      for v:=1 to 4 do
      a[h,v]:=0;
      goto m1;
    end;
end.