cross.pas

关于课件 好多种结构的算法 等等 大家自己看吧

program cross(input,output);
var
 a:array[1..3,1..3] of 0..2;
 w,n:array[1..8,1..2] of -2..2;
 i,j:integer;
 ch:char;
 cturn,over:boolean;
procedure youinput;
begin
 writeln('Please input (i,j):');
 i:=0;j:=0;
 while (i<=0) or(i>3) or(j<=0)or(j>3) do readln(i,j);
 while a[i,j]<>2 do readln(i,j);
 a[i,j]:=0;
 cturn:=true;
end;
procedure print;
var i,j:integer;
begin
  for i:=1 to 3 do write(i:4);
  writeln;
  for i:=1 to 3 do
   begin
    write(i:1);
    case a[i,1] of
     0:write('O':3);
     1:write('X':3);
     2:write(' ':3);
    end;
    for j:=2 to 3 do
     case a[i,j] of
      0:write('O':4);
      1:write('X':4);
      2:write(' ':4);
     end;
    writeln;
    end;
end;
function try(i,j:integer):integer;
var
  max,score,r1,c1,r2,c2,k:integer;
begin
 max:=-1;
 for k:=1 to 8 do
  begin
    r1:=i+w[k,1];
    c1:=j+w[k,2];
    r2:=i+n[k,1];
    c2:=j+n[k,2];
    if (r1<4)and(r1>0)and(c1<4)and(c1>0)and(r2<4)and(r2>0)and(c2<4)and(c2>0) then
     begin
      if (a[r1,c1]=1) and(a[r2,c2]=1) then score:=50;
      if (a[r1,c1]=0) and(a[r2,c2]=0) then score:=25;
      if (a[r1,c1]=1) and(a[r2,c2]=2) then score:=10;
      if (a[r1,c1]=0) and(a[r2,c2]=2) then score:=8;
      if (a[r1,c1]=2) and(a[r2,c2]=2) then score:=4;
      if max<score then max:=score;
     end;
  end;
 try:=max;
end;

procedure cinput;
var
  i,j,max,maxi,maxj,score:integer;
begin
  max:=0;
  maxi:=1;maxj:=1;
  for i:=1 to 3 do
   for j:=1 to 3 do
    if a[i,j]=2 then
     begin
      score:=try(i,j);
      if max<score then
        begin
         max:=score;
         maxi:=i;
         maxj:=j;
        end;
     end;
  a[maxi,maxj]:=1;
  cturn:=false;
end;
function oneline:boolean;
label
 l;
var
 over:boolean;
 i,j,k,r1,c1,r2,c2:integer;
begin
 over:=true;
 for i:=1 to 3 do
  for j:=1 to 3 do
   if a[i,j]=2 then
    begin
      over:=false;
      goto l;
    end;
 over:=false;
 for i:=1 to 3 do
  for j:=1 to 3 do
   for k:=1 to 8 do
    begin
     r1:=i+w[k,1];
     c1:=j+w[k,2];
     r2:=i+n[k,1];
     c2:=j+n[k,2];
     if (r1<4)and(r1>0)and(c1<4)and(c1>0)and(r2<4)and(r2>0)and(c2<4)and(c2>0) then
      if (a[r1,c1]=a[r2,c2])and(a[r1,c1]=a[i,j])and(a[i,j]<>2) then
       begin
        writeln('game over');
        if a[i,j]=0 then writeln('You won!')
        else writeln('You are DEFEATED!');
        over:=true;
        goto l;
       end;
    end;
 l:oneline:=over;
end;


begin
 w[1,1]:=-2; w[1,2]:=-2;
 w[2,1]:=-2; w[2,2]:=0;
 w[3,1]:=-2; w[3,2]:=2;
 w[4,1]:=0; w[4,2]:=2;
 w[5,1]:=2; w[5,2]:=2;
 w[6,1]:=2; w[6,2]:=0;
 w[7,1]:=2; w[7,2]:=-2;
 w[8,1]:=0; w[8,2]:=-2;
 n[1,1]:=-1; n[1,2]:=-1;
 n[2,1]:=-1; n[2,2]:=0;
 n[3,1]:=-1; n[3,2]:=1;
 n[4,1]:=0; n[4,2]:=1;
 n[5,1]:=1; n[5,2]:=1;
 n[6,1]:=1; n[6,2]:=0;
 n[7,1]:=1; n[7,2]:=-1;
 n[8,1]:=0; n[8,2]:=-1;
 for i:=1 to 3 do
   for j:=1 to 3 do
   a[i,j]:=2;
 print;
 write('please choose who go first?  I--I  C--computer  ');
 readln(ch);
 if (ch='i') or (ch='I') then ch:='I' else ch:='C';
 case ch of
  'I':youinput;
  'C':begin
      a[2,2]:=1;
      cturn:=false;
      end;
 end;
 print;
 over:=false;
 while not over do
   begin
    case cturn of
     true:cinput;
     false:youinput;
    end;
    print;
    over:=oneline;
   end;
 end.