Игра Жизнь - Общие вопросы Delphi

marwell. · 29.05.2013, 23:23

доброго времени суток
захотелось реализовать простейший вариант игры "Жизнь"

создаю класс Tkletka и массив с экземплярами этого класса. Вывожу все на image, карта пока размером 50х50. Пока начальную колонию задаю вручную в коде. Правила простые, но где то у меня ошибка, не пойму где. На заведомо правильно работающем варианте игры при старте с данными условиями результат получается совсем другой, чем у меня. Может кто нибудь наставит на путь истинный?

Код:

type
  Tkletka = class(TObject)
    public
    life: boolean;
    constructor Create(life:boolean);
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public

  end;

var
  Form1: TForm1;
  kletka: Tkletka;
  map1,map2: array[0..51,0..51] of Tkletka; //map1-текущий ход, map2-следующий ход цикла

implementation

{$R *.dfm}
constructor
Tkletka.Create(life: Boolean);
begin
  self.life:=life;
end;
procedure TForm1.Button1Click(Sender: TObject);
procedure paint;
var i,j:byte;
begin
  with image1.Canvas do begin
    Brush.Color:=clBlack;
    Pen.Color:=clGreen;
    FillRect(Image1.ClientRect);
    for i := 1 to 49 do begin
      MoveTo(i*10, 0);
      LineTo(i*10, Image1.Height);
      MoveTo(0, i*10);
      LineTo(Image1.width, i*10);
    end;
    Brush.Color:=clGreen;
    for i := 1 to 50 do begin
      for j := 1 to 50 do begin
        if map2[i,j].life=True then
          Rectangle((i-1)*10,(j-1)*10,(i-1)*10+10,(j-1)*10+10);
        Application.ProcessMessages;
      end;
    end;
  end;
map1:=map2;
end;

procedure cikl;
var
  i,j,k,m,count: Integer;
begin
  for i := 1 to 50 do
    for j := 1 to 50 do begin
      count:=0;
      for k := i-1 to i+1 do begin  //подсчет соседей
        for m := j-1 to j+1 do
          if (i<>k) and (j<>m) then
            if map1[k,m].life=True then
              Inc(count);
      end;
      if map1[i,j].life=True then
        if (count<2) or (count>3) then map2[i,j].life:=False
        else map2[i,j].life:=true
      else if (count=3) then map2[i,j].life:=True;
    end;
  paint;
end;

begin
  cikl;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,j: integer;
begin
  for i := 0 to 51 do
    for j := 0 to 51 do begin
      map1[i,j]:=Tkletka.Create(False);
      map2[i,j]:=Tkletka.Create(false);
    end;

  map1[2,2].life:=true;
  map1[2,3].life:=true;
  map1[2,4].life:=true;
  map1[3,4].life:=true;
  map1[3,3].life:=true;
  map1[3,2].life:=true;
  map1[4,4].life:=true;
  map1[4,3].life:=true;
  map1[4,2].life:=true;
end;

end.

BDA · 30.05.2013, 00:55

Пока упрощал, она заработала

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  map1, map2: array [0 .. 51, 0 .. 51] of boolean;
  // map1-текущий ход, map2-следующий ход цикла

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j, k, m, count: Integer;
begin
  for i := 1 to 50 do
    for j := 1 to 50 do
    begin
      count := 0;
      for k := i - 1 to i + 1 do
        for m := j - 1 to j + 1 do
          Inc(count, ord(map1[k, m]));
      dec(count, ord(map1[i, j]));
      map2[i, j] := (count = 3) or (count = 2) and map1[i, j];
    end;
  map1 := map2;
  repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, j: Integer;
begin
  for i := 0 to 51 do
    for j := 0 to 51 do
    begin
      map1[i, j] := False;
      map2[i, j] := False;
    end;

  map1[2, 2] := True;
  map1[2, 3] := True;
  map1[2, 4] := True;
  map1[3, 4] := True;
  map1[3, 3] := True;
  map1[3, 2] := True;
  map1[4, 4] := True;
  map1[4, 3] := True;
  map1[4, 2] := True;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i, j: byte;
begin
  with Canvas do
  begin
    Brush.Color := clBlack;
    Pen.Color := clGreen;
    FillRect(ClientRect);
    for i := 1 to 49 do
    begin
      MoveTo(i * 10, 0);
      LineTo(i * 10, Height);
      MoveTo(0, i * 10);
      LineTo(width, i * 10);
    end;
    Brush.Color := clGreen;
    for i := 1 to 50 do
    begin
      for j := 1 to 50 do
      begin
        if map1[i, j] then
          Rectangle((i - 1) * 10, (j - 1) * 10, (i - 1) * 10 + 10,
            (j - 1) * 10 + 10);
      end;
    end;
  end;
end;

end.

marwell. · 30.05.2013, 05:24

Цитата:

Сообщение от BDA

Пока упрощал, она заработала

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  map1, map2: array [0 .. 51, 0 .. 51] of boolean;
  // map1-текущий ход, map2-следующий ход цикла

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j, k, m, count: Integer;
begin
  for i := 1 to 50 do
    for j := 1 to 50 do
    begin
      count := 0;
      for k := i - 1 to i + 1 do
        for m := j - 1 to j + 1 do
          Inc(count, ord(map1[k, m]));
      dec(count, ord(map1[i, j]));
      map2[i, j] := (count = 3) or (count = 2) and map1[i, j];
    end;
  map1 := map2;
  repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, j: Integer;
begin
  for i := 0 to 51 do
    for j := 0 to 51 do
    begin
      map1[i, j] := False;
      map2[i, j] := False;
    end;

  map1[2, 2] := True;
  map1[2, 3] := True;
  map1[2, 4] := True;
  map1[3, 4] := True;
  map1[3, 3] := True;
  map1[3, 2] := True;
  map1[4, 4] := True;
  map1[4, 3] := True;
  map1[4, 2] := True;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i, j: byte;
begin
  with Canvas do
  begin
    Brush.Color := clBlack;
    Pen.Color := clGreen;
    FillRect(ClientRect);
    for i := 1 to 49 do
    begin
      MoveTo(i * 10, 0);
      LineTo(i * 10, Height);
      MoveTo(0, i * 10);
      LineTo(width, i * 10);
    end;
    Brush.Color := clGreen;
    for i := 1 to 50 do
    begin
      for j := 1 to 50 do
      begin
        if map1[i, j] then
          Rectangle((i - 1) * 10, (j - 1) * 10, (i - 1) * 10 + 10,
            (j - 1) * 10 + 10);
      end;
    end;
  end;
end;

end.

большое спасибо

я понимаю что использовать класс в данном случае ну совсем не целесообразно, но хотелось бы узнать, в чем я накосячил с этим классом?

evg_m · 30.05.2013, 12:24

procedure TForm1.Button1Click(Sender: TObject);
begin
......
map1 := map2;
repaint;
end;
Мы потеряли нашу исходную карту.
Да она нам не нужна, мы же скопировали ее. А вот и нет, мы скопировали только ссылку на вторую карту.
И теперь (на все следующие ходы) будем по сути работать только со второй картой.

Код:

  map2[i, j] := (count = 3) or (count = 2) and map2[i, j];

НО заменив ВЕЗДЕ map1 на map2

Код:

      for k := i-1 to i+1 do begin  //подсчет соседей
        for m := j-1 to j+1 do
          if (i<>k) and (j<>m) then
            if map2[k,m].life=True then
              Inc(count);
      end;
      if map2[i,j].life=True then
        if (count<2) or (count>3) then map2[i,j].life:=False
        else map2[i,j].life:=true
      else if (count=3) then map2[i,j].life:=True;

Код:

// копирование карты
for j:=1 to 50
for i:=1 to 50
  map1[i,j]:=map2[i,j];

marwell. · 30.05.2013, 12:49

т.е. надо заменить некоторые места на приведенный вами код?

Цитата:

Сообщение от evg_m

Код:

  map2[i, j] := (count = 3) or (count = 2) and map2[i, j];

Код:

      for k := i-1 to i+1 do begin  //подсчет соседей
        for m := j-1 to j+1 do
          if (i<>k) and (j<>m) then
            if map2[k,m].life=True then
              Inc(count);
      end;
      if map2[i,j].life=True then
        if (count<2) or (count>3) then map2[i,j].life:=False
        else map2[i,j].life:=true
      else if (count=3) then map2[i,j].life:=True;

Код:

// копирование карты
for j:=1 to 50
for i:=1 to 50
  map1[i,j]:=map2[i,j];

Я Вас правильно понял?

evg_m · 30.05.2013, 14:06

Цитата:

Я Вас правильно понял?

нет.

ваш код
map1:=map2;
нужен код

Код:

for i:=1 to 50
for j:=1 to 50
  map1[i,j]:=map2[i,j];

все остальное попытки объяснить ПОЧЕМУ из-за

Цитата:

map1:=map2;

Цитата:

На заведомо правильно работающем варианте игры при старте с данными условиями результат получается совсем другой, чем у меня

BDA · 30.05.2013, 14:59

Код:

showmessage(Format('%p %p', [@map1, @map2]));
map1 := map2;
showmessage(Format('%p %p', [@map1, @map2]));

Адреса разные.
evg_m, можете объяснить чуть подробнее? Погуглил реализацию массивов на дельфи - не нашел.
Нашел только:

Цитата:

When we try to copy a multi-dimensional array, we can still use copy, but it will only copy the First dimension array. Each element in the new array will still refer to the old array subelements. Change one, and the other is changed. This is the cause of many a problem when using complex arrays.

Протестировал:

Код:

map1[2, 2] := True;
map2[2, 2] := False;
showmessage(inttostr(ord(map2[2, 2])));
map2 := map1;
showmessage(inttostr(ord(map2[2, 2])));
map2[2, 2] := False;
showmessage(inttostr(ord(map1[2, 2])));

Если map2 стал указывать на map1, то вывод должен быть 010, а он 011.

Или Ваше замечание относилось только к массивам объектов?

Аватар · 30.05.2013, 15:49

Цитата:

Если map2 стал указывать на map1

Так будет только в случае динамических массивов.

marwell. · 30.05.2013, 18:38

с учетом замечаний, получилось вот что (от класса TKletka пока все же не отказался)

Код:

type
  Tkletka = class(TObject)
    public
    life: boolean;
    constructor Create(life:boolean);
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public

  end;

var
  Form1: TForm1;
  kletka: Tkletka;
  map1,map2: array[0..51,0..51] of Tkletka;
  x_pos, y_pos: integer;

implementation

{$R *.dfm}
constructor
Tkletka.Create(life: Boolean);
begin
  self.life:=life;
end;
procedure TForm1.Button1Click(Sender: TObject);
procedure paint;
var i,j:byte;
begin
  with image1.Canvas do begin
    Brush.Color:=clBlack;
    Pen.Color:=clGreen;
    FillRect(Image1.ClientRect);
    for i := 1 to 49 do begin
      MoveTo(i*10, 0);
      LineTo(i*10, Image1.Height);
      MoveTo(0, i*10);
      LineTo(Image1.width, i*10);
    end;
    Brush.Color:=clGreen;
    for i := 1 to 50 do begin
      for j := 1 to 50 do begin
        if map2[i,j].life=True then
          Rectangle((i-1)*10,(j-1)*10,(i-1)*10+10,(j-1)*10+10);
        Application.ProcessMessages;
      end;
    end;
  end;
end;

procedure cikl;
var
  i,j,k,m,count: Integer;
begin
  for i := 1 to 50 do
    for j := 1 to 50 do begin
      count:=0;
      for k := i-1 to i+1 do
        for m := j-1 to j+1 do
          Inc(count, ord(map1[k, m].life));
      dec(count, ord(map1[i, j].life));

      if map1[i,j].life=True then
        if (count<2) or (count>3) then map2[i,j].life:=False
        else map2[i,j].life:=true
      else if (count=3) then map2[i,j].life:=True;
    end;
for j:=1 to 50 do
for i:=1 to 50 do
  map1[i,j]:=map2[i,j];
  paint;
end;

begin
  Image1.Enabled:=False;
  Button1.Caption:='Следующее поколение';
  cikl;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,j: integer;
begin
  for i := 0 to 51 do
    for j := 0 to 51 do begin
      map1[i,j]:=Tkletka.Create(False);
      map2[i,j]:=Tkletka.Create(false);
    end;
    with image1.Canvas do begin
    Brush.Color:=clBlack;
    Pen.Color:=clGreen;
    FillRect(Image1.ClientRect);
    for i := 1 to 49 do begin
      MoveTo(i*10, 0);
      LineTo(i*10, Image1.Height);
      MoveTo(0, i*10);
      LineTo(Image1.width, i*10);
    end;
    end;
    Button1.Caption:='Start';
end;

procedure TForm1.Image1Click(Sender: TObject);
var i,j: integer;
begin
  i := (x_pos div 10)+1;
  j := (y_pos div 10)+1;
  map1[j,i].life:=not map1[j,i].life;
  if map1[j,i].life then
    image1.Canvas.Brush.Color:=clGreen
    else image1.Canvas.Brush.Color:=clBlack;
  image1.canvas.Rectangle((i-1)*10,(j-1)*10,(i-1)*10+10,(j-1)*10+10);
  Application.ProcessMessages;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
x_pos:=x;
y_pos:=y;
end;

end.

начальную конфигурацию задаю кликом по image.
второе поколение вроде бы правильно получается, но третье уже неверно
вот пример, на одном сайте
Снимок1.PNG
Снимок1-2.PNG
Снимок1-3.PNG
у меня же выходит
Снимок2.PNG
Снимок2-1.jpg

marwell. · 30.05.2013, 18:43

извиняюсь, надо было в

Код:

...
for j:=1 to 50 do
for i:=1 to 50 do
  map1[i,j]:=map2[i,j];
  paint;
...

написать

Код:

...
for j:=1 to 50 do
for i:=1 to 50 do
  map1[i,j].life:=map2[i,j].life;
  paint;
...

так все верно получается

30.05.2013, 12:24	#4
evg_m Старожил Регистрация: 20.04.2008 Сообщений: 5,543	procedure TForm1.Button1Click(Sender: TObject); begin ...... map1 := map2; repaint; end; Мы потеряли нашу исходную карту. Да она нам не нужна, мы же скопировали ее. А вот и нет, мы скопировали только ссылку на вторую карту. И теперь (на все следующие ходы) будем по сути работать только со второй картой. Код: `map2[i, j] := (count = 3) or (count = 2) and map2[i, j];` НО заменив ВЕЗДЕ map1 на map2 Код: `for k := i-1 to i+1 do begin //подсчет соседей for m := j-1 to j+1 do if (i<>k) and (j<>m) then if map2[k,m].life=True then Inc(count); end; if map2[i,j].life=True then if (count<2) or (count>3) then map2[i,j].life:=False else map2[i,j].life:=true else if (count=3) then map2[i,j].life:=True;` Код: `// копирование карты for j:=1 to 50 for i:=1 to 50 map1[i,j]:=map2[i,j];` программа — запись алгоритма на языке понятном транслятору

30.05.2013, 18:43	#10
marwell. Пользователь Регистрация: 05.12.2012 Сообщений: 63	извиняюсь, надо было в Код: `... for j:=1 to 50 do for i:=1 to 50 do map1[i,j]:=map2[i,j]; paint; ...` написать Код: `... for j:=1 to 50 do for i:=1 to 50 do map1[i,j].life:=map2[i,j].life; paint; ...` так все верно получается Последний раз редактировалось marwell.; 30.05.2013 в 18:43. Причина: ошибка

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Игра жизнь	Fi11eR	Общие вопросы C/C++	8	22.05.2014 16:52
Игра Жизнь	gusluk	Gamedev - cоздание игр: Unity, OpenGL, DirectX	17	24.05.2012 15:58
Клеточный автомат (Игра Жизнь) в Delphi	nitroes	Фриланс	4	12.03.2012 13:11
Игра Жизнь	VovanZ	Софт	14	02.02.2010 16:46