Крестики-нолики: критика кода - PascalABC.NET

Формулировка задачи:

program crozz;
 
uses
  graphabc;
 
procedure paintfield;
var
  x1, y1, x2, y2, x3, y3, x4, y4: integer;
begin
  setpenwidth(4);
  x1 := 50;
  y1 := 150;
  x2 := 50;
  y2 := 250;
  x3 := 150;
  y3 := 50;
  x4 := 250;
  y4 := 50;
  while x1 < 350 do
  begin
    x1 := x1 + 3;
    line(50, y1, x1, y1);
    x2 := x2 + 3;
    line(50, y2, x2, y2);
    y3 := y3 + 3;
    line(x3, 50, x3, y3);
    y4 := y4 + 3;
    line(x4, 50, x4, y4);
    sleep(1);
  end;
  textout(0, 0, '1');
  textout(200, 0, '2');
  textout(390, 0, '3');
  textout(0, 190, '4');
  textout(200, 190, '5');
  textout(390, 190, '6');
  textout(0, 385, '7');
  textout(200, 385, '8');
  textout(390, 385, '9');
end;
 
procedure givecoordinates(num: integer; var x, y: integer);
begin
  case num of
    1:
      begin
        x := 100;
        y := 100;
      end;
    2:
      begin
        x := 200;
        y := 100;
      end;
    3:
      begin
        x := 300;
        y := 100;
      end;
    4:
      begin
        x := 100;
        y := 200;
      end;
    5:
      begin
        x := 200;
        y := 200;
      end;
    6:
      begin
        x := 300;
        y := 200;
      end;
    7:
      begin
        x := 100;
        y := 300;
      end;
    8:
      begin
        x := 200;
        y := 300;
      end;
    9:
      begin
        x := 300;
        y := 300;
      end;
  end;
end;
 
procedure fieldcoordinates(num: integer; var x, y: integer);
var
  ax, ay: integer;
begin
  givecoordinates(num, ax, ay);
  x := ax div 100;
  y := ay div 100;
end;
 
function getnum(x, y: integer): integer;
begin
  if (x = 1) and (y = 1) then getnum := 1;
  if (x = 2) and (y = 1) then getnum := 2;
  if (x = 3) and (y = 1) then getnum := 3;
  if (x = 1) and (y = 2) then getnum := 4;
  if (x = 2) and (y = 2) then getnum := 5;
  if (x = 3) and (y = 2) then getnum := 6;
  if (x = 1) and (y = 3) then getnum := 7;
  if (x = 2) and (y = 3) then getnum := 8;
  if (x = 3) and (y = 3) then getnum := 9;
end;
 
procedure cross(num: integer);
var
  x1, y1, x2, x, y, xc, yc: integer;
begin
  givecoordinates(num, xc, yc);
  x1 := xc - 25;
  y1 := yc - 25;
  x2 := xc + 25;
  x := 0;
  y := 0;
  while x1 + x < x2 do
  begin
    x := x + 1;
    y := y + 1;
    line(x1, y1, x1 + x, y1 + y);
    line(x2, y1, x2 - x, y1 + y);
    sleep(1);
  end;
end;
 
procedure zero(num: integer);
var
  r, x, y, xc, yc: integer;
  u: real;
begin
  givecoordinates(num, xc, yc);
  r := 25;
  u := -pi / 2;
  moveto(xc, yc - r);
  while u < 2 * pi + pi / 2 do
  begin
    x := xc + round(r * cos(u));
    y := yc + round(r * sin(u));
    lineto(x, y);
    sleep(1);
    u := u + 0.1;
  end;
end;
 
type
  TField = array[0..3, 0..3] of integer;
 
var
  field: TField;
  diag2: integer;

procedure getmove(ch: char);
var
  num, x, y: integer;
begin
  repeat
    Readln(num);
    fieldcoordinates(num, x, y);
  until (field[x, y] = 0) and (x <> 0) and (y <> 0);
  if ch = 'X' then field[x, y] := 1;
  if ch = 'O' then field[x, y] := 10;
end;
 
procedure show();
var
  x, y: integer;
begin
  for x := 1 to 3 do
    for y := 1 to 3 do
      if field[x, y] = 1 then cross(getnum(x, y))
      else if field[x, y] = 10 then zero(getnum(x, y))
end;
 
procedure count;
var
  x, y: integer;
begin
  for y := 1 to 3 do
    field[0, y] := field[1, y] + field[2, y] + field[3, y];
  for x := 1 to 3 do
    field[x, 0] := field[x, 1] + field[x, 2] + field[x, 3];
  field[0, 0] := field[1, 1] + field[2, 2] + field[3, 3];
  diag2 := field[1, 3] + field[2, 2] + field[3, 1];
end;
 
function check: char;
var
  x, y: integer;
begin
  count;
  for y := 1 to 3 do 
  begin
    if field[0, y] = 3 then check := 'X';
    if field[0, y] = 30 then check := 'O';
  end;
  for x := 1 to 3 do 
  begin
    if field[x, 0] = 3 then check := 'X';
    if field[x, 0] = 30 then check := 'O';
  end;
  if field[0, 0] = 3 then check := 'X';
  if field[0, 0] = 30 then check := 'O';
  if diag2 = 3 then check := 'X';
  if diag2 = 30 then check := 'O';
end;
 
procedure giveresult;
begin
  if check = 'X' then begin
    TextOut(5, 5, 'Крестики выиграли');
    Readln;
    CloseWindow;
  end;
  if check = 'O' then begin
    TextOut(5, 5, 'Нолики выиграли');
    Readln;
    CloseWindow;
  end;
end;
 
function needed: integer;
begin
  if (field[0, 0] = 2) or (field[0, 0] = 20) then begin
    if field[1, 1] = 0 then Result := 1;
    if field[2, 2] = 0 then Result := 2;
    if field[3, 3] = 0 then Result := 3;
  end; 
  if (field[1, 0] = 2) or (field[0, 0] = 20) then begin
    if field[1, 1] = 0 then Result := 1;
    if field[1, 2] = 0 then Result := 4;
    if field[1, 3] = 0 then Result := 7;
  end;
  if (field[2, 0] = 2) or (field[0, 0] = 20) then begin
    if field[2, 1] = 0 then Result := 2;
    if field[2, 2] = 0 then Result := 5;
    if field[2, 3] = 0 then Result := 8;
  end;
  if (field[3, 0] = 2) or (field[0, 0] = 20) then begin
    if field[3, 1] = 0 then Result := 3;
    if field[3, 2] = 0 then Result := 6;
    if field[3, 3] = 0 then Result := 9;
  end;
  if (field[0, 1] = 2) or (field[0, 0] = 20) then begin
    if field[1, 1] = 0 then Result := 1;
    if field[2, 1] = 0 then Result := 2;
    if field[3, 1] = 0 then Result := 3;
  end;
  
  if (field[0, 2] = 2) or (field[0, 0] = 20) then begin
    if field[1, 2] = 0 then Result := 4;
    if field[2, 2] = 0 then Result := 5;
    if field[3, 2] = 0 then Result := 6;
  end;
  
  if (field[0, 3] = 2) or (field[0, 0] = 20) then begin
    if field[1, 3] = 0 then Result := 7;
    if field[2, 3] = 0 then Result := 8;
    if field[3, 3] = 0 then Result := 9;
  end;
  
  if (diag2 = 2) or (diag2 = 20) then begin
    if field[3, 1] = 0 then Result := 3;
    if field[2, 2] = 0 then Result := 5;
    if field[1, 3] = 0 then Result := 7;
  end;
end;
 
function createmove(ch: char): integer;
var
  num, x, y: integer;
begin
  count;
  num := needed;
  if num <> 0 then Result := num else begin
    if field[2, 2] = 0 then begin
      Result := 5;
      exit;
    end;
    repeat
      num := Random(9) + 1;
      fieldcoordinates(num, x, y);
    until field[x, y] = 0;
    Result := num;
  end;
end;
 
procedure UseCreatedMove(ch: char);
var
  x, y: integer;
begin
  fieldcoordinates(createmove(ch), x, y);
  if ch = 'X' then field[x, y] := 1;
  if ch = 'O' then field[x, y] := 10;
end;
 
begin
  setwindowsize(400, 400);
  SetWindowCaption('Крестики-нолики');
  
  paintfield;
  getmove('X');
  show();
  usecreatedmove('O');
  show();
  getmove('X');
  show();
  usecreatedmove('O');
  show();
  getmove('X');
  show();
  giveresult;
  usecreatedmove('O');
  show();
  giveresult;
  getmove('X');
  show();
  giveresult;
  usecreatedmove('O');
  show();
  giveresult;
  getmove('X');
  show();
  giveresult;
  TextOut(5, 5, 'Ничья');
  Readln;
  CloseWindow;
end.

Жду замечаний, предложений, идей. Кое что уже знаю, но не знаю как изменить.

Исправил обработку основной диагонали

program crozz;
 
uses
  graphabc;
 
procedure paintfield;
var
  x1, y1, x2, y2, x3, y3, x4, y4: integer;
begin
  setpenwidth(4);
  x1 := 50;
  y1 := 150;
  x2 := 50;
  y2 := 250;
  x3 := 150;
  y3 := 50;
  x4 := 250;
  y4 := 50;
  while x1 < 350 do
  begin
    x1 := x1 + 3;
    line(50, y1, x1, y1);
    x2 := x2 + 3;
    line(50, y2, x2, y2);
    y3 := y3 + 3;
    line(x3, 50, x3, y3);
    y4 := y4 + 3;
    line(x4, 50, x4, y4);
    sleep(1);
  end;
  textout(0, 0, '1');
  textout(200, 0, '2');
  textout(390, 0, '3');
  textout(0, 190, '4');
  textout(200, 190, '5');
  textout(390, 190, '6');
  textout(0, 385, '7');
  textout(200, 385, '8');
  textout(390, 385, '9');
end;
 
procedure givecoordinates(num: integer; var x, y: integer);
begin
  case num of
    1:
      begin
        x := 100;
        y := 100;
      end;
    2:
      begin
        x := 200;
        y := 100;
      end;
    3:
      begin
        x := 300;
        y := 100;
      end;
    4:
      begin
        x := 100;
        y := 200;
      end;
    5:
      begin
        x := 200;
        y := 200;
      end;
    6:
      begin
        x := 300;
        y := 200;
      end;
    7:
      begin
        x := 100;
        y := 300;
      end;
    8:
      begin
        x := 200;
        y := 300;
      end;
    9:
      begin
        x := 300;
        y := 300;
      end;
  end;
end;
 
procedure fieldcoordinates(num: integer; var x, y: integer);
var
  ax, ay: integer;
begin
  givecoordinates(num, ax, ay);
  x := ax div 100;
  y := ay div 100;
end;
 
function getnum(x, y: integer): integer;
begin
  if (x = 1) and (y = 1) then getnum := 1;
  if (x = 2) and (y = 1) then getnum := 2;
  if (x = 3) and (y = 1) then getnum := 3;
  if (x = 1) and (y = 2) then getnum := 4;
  if (x = 2) and (y = 2) then getnum := 5;
  if (x = 3) and (y = 2) then getnum := 6;
  if (x = 1) and (y = 3) then getnum := 7;
  if (x = 2) and (y = 3) then getnum := 8;
  if (x = 3) and (y = 3) then getnum := 9;
end;
 
procedure cross(num: integer);
var
  x1, y1, x2, x, y, xc, yc: integer;
begin
  givecoordinates(num, xc, yc);
  x1 := xc - 25;
  y1 := yc - 25;
  x2 := xc + 25;
  x := 0;
  y := 0;
  while x1 + x < x2 do
  begin
    x := x + 1;
    y := y + 1;
    line(x1, y1, x1 + x, y1 + y);
    line(x2, y1, x2 - x, y1 + y);
    sleep(1);
  end;
end;
 
procedure zero(num: integer);
var
  r, x, y, xc, yc: integer;
  u: real;
begin
  givecoordinates(num, xc, yc);
  r := 25;
  u := -pi / 2;
  moveto(xc, yc - r);
  while u < 2 * pi + pi / 2 do
  begin
    x := xc + round(r * cos(u));
    y := yc + round(r * sin(u));
    lineto(x, y);
    sleep(1);
    u := u + 0.1;
  end;
end;
 
type
  TField = array[0..3, 0..3] of integer;
 
var
  field: TField;
  diag2: integer;

procedure getmove(ch: char);
var
  num, x, y: integer;
begin
  repeat
    Readln(num);
    fieldcoordinates(num, x, y);
  until (field[x, y] = 0) and (x <> 0) and (y <> 0);
  if ch = 'X' then field[x, y] := 1;
  if ch = 'O' then field[x, y] := 10;
end;
 
procedure show();
var
  x, y: integer;
begin
  for x := 1 to 3 do
    for y := 1 to 3 do
      if field[x, y] = 1 then cross(getnum(x, y))
      else if field[x, y] = 10 then zero(getnum(x, y))
end;
 
procedure count;
var
  x, y: integer;
begin
  for y := 1 to 3 do
    field[0, y] := field[1, y] + field[2, y] + field[3, y];
  for x := 1 to 3 do
    field[x, 0] := field[x, 1] + field[x, 2] + field[x, 3];
  field[0, 0] := field[1, 1] + field[2, 2] + field[3, 3];
  diag2 := field[1, 3] + field[2, 2] + field[3, 1];
end;
 
function check: char;
var
  x, y: integer;
begin
  count;
  for y := 1 to 3 do 
  begin
    if field[0, y] = 3 then check := 'X';
    if field[0, y] = 30 then check := 'O';
  end;
  for x := 1 to 3 do 
  begin
    if field[x, 0] = 3 then check := 'X';
    if field[x, 0] = 30 then check := 'O';
  end;
  if field[0, 0] = 3 then check := 'X';
  if field[0, 0] = 30 then check := 'O';
  if diag2 = 3 then check := 'X';
  if diag2 = 30 then check := 'O';
end;
 
procedure giveresult;
begin
  if check = 'X' then begin
    TextOut(5, 5, 'Крестики выиграли');
    Readln;
    CloseWindow;
  end;
  if check = 'O' then begin
    TextOut(5, 5, 'Нолики выиграли');
    Readln;
    CloseWindow;
  end;
end;
 
function needed: integer;
begin
  if (field[0, 0] = 2) or (field[0, 0] = 20) then begin
    if field[1, 1] = 0 then Result := 1;
    if field[2, 2] = 0 then Result := 5;
    if field[3, 3] = 0 then Result := 9;
  end; 
  if (field[1, 0] = 2) or (field[0, 0] = 20) then begin
    if field[1, 1] = 0 then Result := 1;
    if field[1, 2] = 0 then Result := 4;
    if field[1, 3] = 0 then Result := 7;
  end;
  if (field[2, 0] = 2) or (field[0, 0] = 20) then begin
    if field[2, 1] = 0 then Result := 2;
    if field[2, 2] = 0 then Result := 5;
    if field[2, 3] = 0 then Result := 8;
  end;
  if (field[3, 0] = 2) or (field[0, 0] = 20) then begin
    if field[3, 1] = 0 then Result := 3;
    if field[3, 2] = 0 then Result := 6;
    if field[3, 3] = 0 then Result := 9;
  end;
  if (field[0, 1] = 2) or (field[0, 0] = 20) then begin
    if field[1, 1] = 0 then Result := 1;
    if field[2, 1] = 0 then Result := 2;
    if field[3, 1] = 0 then Result := 3;
  end;
  
  if (field[0, 2] = 2) or (field[0, 0] = 20) then begin
    if field[1, 2] = 0 then Result := 4;
    if field[2, 2] = 0 then Result := 5;
    if field[3, 2] = 0 then Result := 6;
  end;
  
  if (field[0, 3] = 2) or (field[0, 0] = 20) then begin
    if field[1, 3] = 0 then Result := 7;
    if field[2, 3] = 0 then Result := 8;
    if field[3, 3] = 0 then Result := 9;
  end;
  
  if (diag2 = 2) or (diag2 = 20) then begin
    if field[3, 1] = 0 then Result := 3;
    if field[2, 2] = 0 then Result := 5;
    if field[1, 3] = 0 then Result := 7;
  end;
end;
 
function createmove(ch: char): integer;
var
  num, x, y: integer;
begin
  count;
  num := needed;
  if num <> 0 then Result := num else begin
    if field[2, 2] = 0 then begin
      Result := 5;
      exit;
    end;
    repeat
      num := Random(9) + 1;
      fieldcoordinates(num, x, y);
    until field[x, y] = 0;
    Result := num;
  end;
end;
 
procedure UseCreatedMove(ch: char);
var
  x, y: integer;
begin
  fieldcoordinates(createmove(ch), x, y);
  if ch = 'X' then field[x, y] := 1;
  if ch = 'O' then field[x, y] := 10;
end;
 
begin
  setwindowsize(400, 400);
  SetWindowCaption('Крестики-нолики');
  
  paintfield;
  getmove('X');
  show();
  usecreatedmove('O');
  show();
  getmove('X');
  show();
  usecreatedmove('O');
  show();
  getmove('X');
  show();
  giveresult;
  usecreatedmove('O');
  show();
  giveresult;
  getmove('X');
  show();
  giveresult;
  usecreatedmove('O');
  show();
  giveresult;
  getmove('X');
  show();
  giveresult;
  TextOut(5, 5, 'Ничья');
  Readln;
  CloseWindow;
end.

Решение задачи: «Крестики-нолики: критика кода»

Листинг программы

uses GraphABC;
var
  a:array[0..2,0..2] of integer;
  i,j,dy,dx:integer;
  finish:boolean;
  MovA,MovB:integer;
procedure DrawPole;
var
  i,j:integer;
begin
  if not finish then begin
  SetFontSize(30);
  LockDrawing;
  ClearWindow;
  SetPenStyle(psDashDot);
  SetPenWidth(1);
  Rectangle(dx*WindowWidth div 3+5,dy*WindowHeight div 3+5,(dx+1)*WindowWidth div 3-5,(dy+1)*WindowHeight div 3-5);
  SetPenStyle(psSolid);
  SetPenWidth(4);
  for i:=1 to 2 do begin
    line(WindowWidth div 3 *i,10,WindowWidth div 3 *i,WindowHeight-10);
    line(10,i*WindowHeight div 3,WindowWidth-10,i*WindowHeight div 3);
  end;  
  for i:=0 to 2 do 
      for j:=0 to 2 do 
        if a[i,j]<0 then TextOut(40+i*WindowWidth div 3,10+j*WindowHeight div 3,'0') else 
        if a[i,j]>0 then TextOut(40+i*WindowWidth div 3,10+j*WindowHeight div 3,'X');
    UnlockDrawing;
  end;  
end;
function checkend:boolean;
var
  i,j,s1,s2,s3,s4:integer;
begin
  checkend:=true;
  s2:=0;s3:=0;
  for i:=0 to 2 do begin
    s1:=0;s2:=0;
    for j:=0 to 2 do begin 
      s1:=s1+a[i,j];
      s2:=s2+a[j,i];
    end;  
    s3:=s3+a[i,i];
    s4:=s4+a[i,2-i];
    if (abs(s4)=3) or (abs(s1)=3) or (abs(s2)=3) or (abs(s3)=3) then exit;
   end;   
   checkend:=false;
end;   
 
function checkdraw:boolean;
var
  i,j:integer;
begin
  checkdraw:=false;
  for i:=0 to 2 do 
    for j:=0 to 2 do if a[i,j]=0 then exit;
   checkdraw:=true; 
end;
 
procedure Bot;
var
  i,j:integer;
begin
  for i:=0 to 2 do
    for j:=0 to 2 do
      if a[i,j]=0 then begin 
        a[i,j]:=-1;
        if checkend then begin MovA:=i;MovB:=j;exit;end;
        a[i,j]:=0;
      end;
  for i:=0 to 2 do
    for j:=0 to 2 do
      if a[i,j]=0 then begin 
        a[i,j]:=1;
        if checkend then begin MovA:=i;MovB:=j;a[i,j]:=0;exit;end;
        a[i,j]:=0;
      end;
      MovA:=-1;
   for i:=0 to 2 do
     for j:=0 to 2 do
       if a[i,j]=0 then begin MovA:=i;MovB:=j;end;
    if a[1,1]=0 then begin MovA:=1;MovB:=1;end;   
end;     
procedure MakeMove(Player:integer);
var
  n:integer;
begin
  if a[dx,dy]<>0 then exit;
  a[dx,dy]:=Player;
  if checkend then begin DrawPole;TextOut(1,1,'Вы выйграли');finish:=true;end;
  if checkdraw then begin DrawPole;TextOut(1,1,'Ничья');finish:=true;end;
  if not finish then begin
    Bot;
    a[MovA,MovB]:=-1;
    if checkend then begin DrawPole;TextOut(1,1,'Я выйграл');finish:=true;end;
    if checkdraw then begin DrawPole;TextOut(1,1,'Ничья');finish:=true;end;
  end;  
end;
procedure KeyPress(Key:Integer);
begin
  case Key of
    VK_Up:dy:=dy-ord(dy>0);
    VK_Down:dy:=dy+ord(dy<2);
    VK_Left:dx:=dx-ord(dx>0);
    VK_Right:dx:=dx+ord(dx<2);
    VK_Enter:MakeMove(1);
  end;
  DrawPole;
end;  
begin
  OnKeyUp:=KeyPress;
  finish:=false;
  dx:=0;dy:=0;
  Window.SetSize(320,240);
  Window.CenterOnScreen;
  DrawPole;
end.

Объяснение кода листинга программы

Объявлены переменные:
- a: массив размером [0..2,0..2] для хранения значений игры (20x20 клеточное поле)
- i, j, dy, dx: целочисленные переменные для хода игрока и определения направления хода компьютера
- finish: булевая переменная для определения окончания игры
- MovA, MovB: целочисленные переменные для хранения координат последнего хода компьютера
В функции checkend проверяется, закончилась ли игра. Если сумма элементов в одной из строк, столбцов или диагоналей равна 3, то игра заканчивается.
В функции checkdraw проверяется, заполнены ли все клетки поля. Если найдена пустая клетка, то игра еще не закончилась.
В процедуре Bot компьютер делает ход, ставя крестик или нолик в пустую клетку. Если после хода компьютер обнаруживает ситуацию, когда игра заканчивается, то выводится сообщение об победе и устанавливается флаг finish.
В процедуре MakeMove при нажатии клавиши игрок делает ход, вызывается функция checkend для проверки окончания игры, и если игра закончилась, выводится соответствующее сообщение и устанавливается флаг finish.
В процедуре KeyPress при нажатии клавиш управления изменяются значения dx и dy, и вызывается MakeMove для осуществления хода игрока.
В начале программы устанавливаются размеры окна (320x240), центр окна выравнивается по центру экрана, инициализируются значения dx и dy, и начинается основной цикл игры, в котором происходит проверка нажатия клавиш и вызов функции DrawPole для отрисовки поля и текущего состояния игры.