2048

来源：互联网发布：top域名值得投资吗? 编辑：程序博客网时间：2024/06/06 11:35

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.

阅读全文

1 0