2048

2048小游戏（自己打的，但是游戏还是创造者的）

 w          上
asd       左下右

待完善，不过也可以玩了

var
  n,i,x,y,v:longint;
  c,d:char;
  b:boolean;
  a:array[0..5,0..5]of longint;
  z:array[1..4]of longint;

procedure print;
var
  i,j,c:longint;
begin
  for i:=1 to 4 do
    for j:=1 to 4 do
      if a[i,j]>10 then
        begin
          z[j]:=1;
          if a[i,j]>100 then inc(z[j]);
          if a[i,j]>1000 then inc(z[j]);
        end;
  for i:=1 to 4 do
    begin
      for j:=1 to 4 do
        begin
          write(a[i,j],' ');
          for c:=1 to z[j] do
            write(' ');
        end;
      writeln;
    end;
end;

procedure left;
var
  i,j,k:longint;
begin
  for i:=1 to 4 do
    begin
      k:=1;
      for j:=1 to 4 do
          if (a[i,j]>0)and(k<=j) then
            begin
              if k<j then
                begin
                  a[i,k]:=a[i,j];
                  a[i,j]:=0;
                end;

              inc(k);
            end;
      for j:=2 to 4 do
          if (a[i,j]=a[i,j-1])and(a[i,j]>0) then
            begin
              a[i,j-1]:=a[i,j]*2;
              a[i,j]:=0;
              for k:=j to 3 do
                begin
                  a[i,k]:=a[i,k+1];
                  a[i,k+1]:=0;
                end;
            end;
    end;
end;

procedure right;
var
  i,j,k:longint;
begin
  for i:=1 to 4 do
    begin
      k:=4;
      for j:=4 downto 1 do
          if (a[i,j]>0)and(k>=j) then
            begin
              if k>j then
                begin
                  a[i,k]:=a[i,j];
                  a[i,j]:=0;
                end;

              dec(k);
            end;
      for j:=3 downto 1 do
          if (a[i,j]=a[i,j+1])and(a[i,j]>0) then
            begin
              a[i,j+1]:=a[i,j]*2;
              a[i,j]:=0;
              for k:=j downto 2 do
                begin
                  a[i,k]:=a[i,k-1];
                  a[i,k-1]:=0;
                end;
            end;
    end;
end;

procedure up;
var
  i,j,k:longint;
begin
  for i:=1 to 4 do
    begin
      k:=1;
      for j:=1 to 4 do
          if (a[j,i]>0)and(k<=j) then
            begin
              if k<j then
                begin
                  a[k,i]:=a[j,i];
                  a[j,i]:=0;
                end;

              inc(k);
            end;
      for j:=2 to 4 do
          if (a[j,i]=a[j-1,i])and(a[j,i]>0) then
            begin
              a[j-1,i]:=a[j,i]*2;
              a[j,i]:=0;
              for k:=j to 3 do
                begin
                  a[k,i]:=a[k+1,i];
                  a[k+1,i]:=0;
                end;
            end;
    end;
end;

procedure down;
var
  i,j,k:longint;
begin
  for i:=1 to 4 do
    begin
      k:=4;
      for j:=4 downto 1 do
          if (a[j,i]>0)and(k>=j) then
            begin
              if k>j then
                begin
                  a[k,i]:=a[j,i];
                  a[j,i]:=0;
                end;

              dec(k);
            end;
      for j:=3 downto 1 do
          if (a[j,i]=a[j+1,i])and(a[j,i]>0) then
            begin
              a[j+1,i]:=a[j,i]*2;
              a[j,i]:=0;
              for k:=j downto 2 do
                begin
                  a[k,i]:=a[k-1,i];
                  a[k-1,i]:=0;
                end;
            end;
    end;
end;

procedure night;
var
  i,j:longint;
begin
  b:=false;
  for i:=1 to 4 do
    for j:=1 to 4 do
        if a[i,j]=0 then
          begin
            b:=true;exit;
          end;
end;

procedure ran(var x,y,v:longint);
var
  c,i,j:longint;
begin
  c:=random(1);
  if c=0 then v:=2 else v:=4;
  x:=random(3);y:=random(3);
  while a[x+1,y+1]<>0 do
    begin
      x:=random(3);y:=random(3);
      if a[x+1,y+1]<>0 then
        for i:=1 to 4 do
          for j:=1 to 4 do
            if a[i,j]=0 then
              begin
                x:=i-1;y:=j-1;exit;
              end;
    end;
end;

begin
  b:=true;
  randomize;
  while b do
    begin
      ran(x,y,v);
      a[x+1,y+1]:=v;
      print;
      readln(c);
      if c='a' then left else
      if c='w' then up else
      if c='d' then right else down;
      night;
    end;
  writeln('Game over!');
end.