Life Game
Manfred Eigen – Ruthild Winkler: A játék című 1981-ben
megjelent könyvnek a 231-239. oldalán leírt, J. H. Conway nyomán megjelentetett
életjáték számítógépes megvalósítását találjuk ebben a
programban. A sejtek (kék korongok) túlélési szabályai:
1. Túlélés: Ha egy korongnak 2 vagy 3 szomszédja van (a
8-ból!), akkor a következő generációban is él.
2. Halál: Ha egy korongnak háromnál több szomszédja van,
akkor túlnépesedés miatt kihal, ha kettőnél kevesebb, akkor elnéptelenedés
miatt hal ki.
3. Születés: ha egy helyen nincs korong, de pontosan
három szomszédja van, akkor ott korong születik.
A lehetőségekre a látható menükből könnyen
következtethetünk. Az élettér a pontok halmaza 60x60-as. Kérhetünk a géptől
meghatározott számú, véletlen elhelyezkedésű elemet. Saját magunk is
helyezhetünk el és vehetünk le elemeket egér kettős kattintással. Lehet
lépésenként lejátszani az életfolyamatokat, de lehet automatikus ismétléssel
is. Az idő, a két ciklus közötti várakozási időt jelenti. Két beprogramozott
szituációt is választhatunk, az egyik a sikló, mely vándorol az élettérben, és
egy ágyúnak nevezett konfiguráció, mely tetszőleges sokszor megismétli önmagát.
Az automatikus fázisok a Stop funkcióval megállíthatók, de starttal újra
indíthatók.
Egy véletlen indítás:
A „kihalási” állapot:
Az
ágyú működés közben:
A program listája:
unit ULifeGame;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Spin;
type
TfmLifeGame = class(TForm)
btKezdet: TButton;
btKilep: TButton;
btKovetkezo: TButton;
edEgyedSz: TEdit;
lbEgyed: TLabel;
tiIdozito: TTimer;
btStart: TButton;
btStop: TButton;
lbLepesSz: TLabel;
lbAktualSz: TLabel;
cbVegeFigy: TCheckBox;
btTorles: TButton;
lbVege: TLabel;
seSebess: TSpinEdit;
lbIdo: TLabel;
btSiklo: TButton;
btAgyu: TButton;
Procedure Start;
Procedure Kepre;
Procedure Ciklus;
Function VegeVan: Boolean;
procedure btKezdetClick(Sender: TObject);
procedure btKilepClick(Sender: TObject);
procedure btKovetkezoClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure tiIdozitoTimer(Sender: TObject);
procedure btStartClick(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure seSebessChange(Sender: TObject);
procedure btTorlesClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormPaint(Sender: TObject);
procedure FormDblClick(Sender: TObject);
procedure btSikloClick(Sender: TObject);
procedure btAgyuClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const Max=60;
D=12;
Dx=6;
Dy=6;
Bal=150;
Fent=20;
R=5;
FigyH=10;
var
fmLifeGame: TfmLifeGame;
Et, Eo, Sz: Array[0..Max,0..Max] Of Byte;
Mx, My: Integer;
EgyedSz, LepesSz, AktualSz: Word;
EggyesLepo, Folyamatos, VegFigyelo: Boolean;
FigyTomb: Array[1..FigyH] Of Word;
SikloVan, AgyuVan: Boolean;
implementation
{$R *.DFM}
procedure TfmLifeGame.Start;
Var I, J, M, N: Word;
Begin
Randomize; EgyedSz:= StrToInt(edEgyedSz.Text); LepesSz:= 0;
If EgyedSz>Max*Max Then EgyedSz:= Max*Max;
edEgyedSz.Text:= IntToStr(EgyedSz);
lbAktualSz.Caption:= IntToStr(EgyedSz);
lbLepesSz.Caption:= IntToStr(LepesSz);
For I:= 0 To Max Do For J:= 0 To Max Do Et[I,J]:= 0; Eo:= Et; Sz:= Et;
For I:= 1 To EgyedSz Do
Begin
Repeat
M:= Random(Max+1);
N:= Random(Max+1);
Until Et[M,N]=0;
Et[M,N]:= 1;
End;
For I:= 1 To FigyH Do FigyTomb[I]:= 0;
End;
procedure TfmLifeGame.Ciklus;
Var I, J, SS: Word;
Begin
For I:= 0 To Max Do For J:= 0 To Max Do Sz[I,J]:= 0; Eo:= Et;
For I:= 1 To Max-1 Do For J:= 1 To Max-1 Do
Begin
SS:= Et[I-1,J-1]+Et[I-1, J]+Et[I-1,J+1]+
Et[ I,J-1]+ Et[ I,J+1]+
Et[I+1,J-1]+Et[I+1, J]+Et[I+1,J+1];
If (Et[I,J]=0) And (SS=3) Then Sz[I,J]:= 1; //születik
If Et[I,J]=1 Then //ha élt
Case SS Of
2,3: Sz[I,J]:= 1; //túlél
Else Sz[I,J]:= 0; //túlnépesedés miatt kihal
End; //vagy 0,1 esetén elszigetelődés miatt hal ki
End;
Et:= Sz;
End;
procedure TfmLifeGame.Kepre;
Var I, J: Word;
Begin
With Canvas Do
Begin
Pen.Color:= clBtnFace;
Brush.Color:= clBtnFace; Rectangle(Bal-R,Fent-R,900,800);
Pen.Color:= clBlue; Brush.Color:= clBlue;
For I:= 0 To Max Do For J:= 0 To Max Do If Et[I,J]=0 Then
Pixels[Bal+D*I,Fent+D*J]:= clBlue Else
Ellipse(Bal+D*I-R,Fent+D*J-R, Bal+D*I+R,Fent+D*J+R)
End;
End;
Function TfmLifeGame.VegeVan: Boolean;
Var I, J: Word;
Vege: Boolean;
Begin
Vege:= True; VegeVan:= False;
If cbVegeFigy.Checked Then
Begin
For I:= 1 To FigyH-1 Do For J:= I+1 To FigyH Do
If FigyTomb[I]<>FigyTomb[J] Then Vege:= False;
lbVege.Visible:= Vege;
VegeVan:= Vege; Exit;
End;
End;
procedure TfmLifeGame.btKezdetClick(Sender: TObject);
begin
Start;
Kepre;
lbVege.Visible:= False;
SikloVan:= False;
AgyuVan:= False;
end;
procedure TfmLifeGame.btKilepClick(Sender: TObject);
begin
Close;
end;
procedure TfmLifeGame.btKovetkezoClick(Sender: TObject);
Var I, J, N: Word;
Ures: Boolean;
begin
Inc(LepesSz); lbLepesSz.Caption:= IntToStr(LepesSz); Ciklus;
With Canvas Do
Begin
Pen.Color:= clBtnFace;
Brush.Color:= clBtnFace; Rectangle(Bal-R,Fent-R,900,800);
Pen.Color:= clBlue; Brush.Color:= clBlue;
N:= 0; Ures:= True;
For I:= 0 To Max Do For J:= 0 To Max Do If Et[I,J]=0 Then
Pixels[Bal+D*I,Fent+D*J]:= clBlue Else
Begin
Ellipse(Bal+D*I-R,Fent+D*J-R, Bal+D*I+R,Fent+D*J+R);
Inc(N); Ures:= False;
End;
End;
If Ures Then Begin Folyamatos:= False; lbVege.Visible:= True; Exit End;
For I:= 1 To FigyH-1 Do FigyTomb[I]:= FigyTomb[I+1]; FigyTomb[FigyH]:= N;
lbAktualSz.Caption:= IntToStr(N);
end;
procedure TfmLifeGame.FormCreate(Sender: TObject);
begin
EgyedSz:= 1000; AktualSz:= EgyedSz; LepesSz:= 0;
edEgyedSz.Text:= IntToStr(EgyedSz);
lbLepesSz.Caption:= IntToStr(LepesSz);
lbAktualSz.Caption:= IntToStr(AktualSz);
Eggyeslepo:= True;
Folyamatos:= False;
cbVegeFigy.Checked:= True;
SikloVan:= False;
AgyuVan:= False;
end;
procedure TfmLifeGame.FormPaint(Sender: TObject);
begin
Kepre;
end;
procedure TfmLifeGame.tiIdozitoTimer(Sender: TObject);
begin
If Not Folyamatos Then Exit;
If (Not SikloVan Or AgyuVan) Then
If VegeVan Then Begin Folyamatos:= False; lbVege.Visible:= True End;
btKovetkezoClick(Sender);
end;
procedure TfmLifeGame.btStartClick(Sender: TObject);
begin
Folyamatos:= True;
end;
procedure TfmLifeGame.btStopClick(Sender: TObject);
begin
Folyamatos:= False;
end;
procedure TfmLifeGame.seSebessChange(Sender: TObject);
begin
tiIdozito.Interval:= StrToInt(seSebess.Text);
end;
procedure TfmLifeGame.btTorlesClick(Sender: TObject);
Var I, J: Word;
begin
For I:= 0 To Max Do For J:= 0 To Max Do Et[I,J]:= 0; Eo:= Et; Sz:= Et;
LepesSz:= 0; AktualSz:= 0;
Kepre;
end;
procedure TfmLifeGame.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Mx:= X;
My:= Y;
end;
procedure TfmLifeGame.FormDblClick(Sender: TObject);
Var I, J: Word;
begin
edEgyedSz.Text:= '0'; AktualSz:= 0; LepesSz:= 0;
Et[(Mx-Bal+Dx) Div D,(My-Fent+Dy) Div D]:=
1 - Et[(Mx-Bal+Dx) Div D,(My-Fent+Dy) Div D];
For I:= 0 To Max Do For J:= 0 To Max Do If Et[I,J]=1 Then Inc(AktualSz);
Kepre; lbAktualSz.Caption:= IntToStr(AktualSz);
end;
procedure TfmLifeGame.btSikloClick(Sender: TObject);
begin
SikloVan:= True;
AgyuVan:= False;
btTorlesClick(Sender);
Et[2,1]:= 1;
Et[3,2]:= 1;
Et[1,3]:= 1;
Et[2,3]:= 1;
Et[3,3]:= 1;
Kepre;
Folyamatos:= False;
end;
procedure TfmLifeGame.btAgyuClick(Sender: TObject);
Var Ex, Ey: Word;
begin
SikloVan:= True;
AgyuVan:= False;
btTorlesClick(Sender);
Et[2,7]:= 1; Et[2,8]:= 1;
Et[3,7]:= 1; Et[3,8]:= 1;
Et[13,7]:= 1; Et[13,8]:= 1; Et[13,9]:= 1;
Et[14,6]:= 1; Et[14,10]:= 1;
Et[15,5]:= 1; Et[15,11]:= 1;
Et[16,6]:= 1; Et[16,10]:= 1;
Et[17,7]:= 1; Et[17,8]:= 1; Et[17,9]:= 1;
Et[18,7]:= 1; Et[18,8]:= 1; Et[18,9]:= 1;
Et[23,5]:= 1; Et[23,6]:= 1; Et[23,7]:= 1;
Et[24,4]:= 1; Et[24,5]:= 1; Et[24,7]:= 1; Et[24,8]:= 1;
Et[25,4]:= 1; Et[25,5]:= 1; Et[25,7]:= 1; Et[25,8]:= 1;
Et[26,4]:= 1; Et[26,5]:= 1; Et[26,6]:= 1; Et[26,7]:= 1; Et[26,8]:= 1;
Et[27,3]:= 1; Et[27,4]:= 1; Et[27,8]:= 1; Et[27,9]:= 1;
Et[32,7]:= 1; Et[32,8]:= 1;
Et[36,5]:= 1; Et[36,6]:= 1;
Et[37,5]:= 1; Et[37,6]:= 1;
Ex:= 38; Ey:= 27; {dx=dy=30}
Et[Ex,Ey]:= 1;
Et[Ex+1,Ey]:= 1;
Et[Ex+2,Ey-1]:= 1; Et[Ex+2,Ey+1]:= 1;
Et[Ex+3,Ey]:= 1;
Et[Ex+4,Ey]:= 1;
Et[Ex+5,Ey]:= 1;
Et[Ex+6,Ey]:= 1;
Et[Ex+7,Ey-1]:= 1; Et[Ex+7,Ey+1]:= 1;
Et[Ex+8,Ey]:= 1;
Et[Ex+9,Ey]:= 1;
Kepre;
Folyamatos:= False;
end;
end.