old/PAS/LIFE.PAS

Uses MyTPU,Graph,CRT,F_mouse;

Var
  Grid : array[1..160,1..120] of boolean;
  Test : array[1..160,1..120] of boolean;
  x,y  : byte;
  xcell,ycell,dl1 : integer;
{-------------============--------------}
Function TestCell(x0,y0:byte):byte;
Var
 counter : byte;
 i,j : -1..1;
Begin
  counter := 0;
  for i := -1 to 1 do
    for j := -1 to 1 do if (x0+i in [1..xcell]) and (y0 + j in [1..ycell]) then if Grid[x0+i,y0+j] then Inc(counter);
  TestCell := counter;
End;{TestCell}
{----------------------------}
Procedure Turn;
Var
 x1,y1 :byte;
Begin
  for x1 := 1 to xcell do
    for y1 := 1 to ycell do Test[x1,y1] := Grid[x1,y1];
  for x1 := 1 to xcell do
    for y1 := 1 to ycell do
     begin
       if Grid[x1,y1] then
         case TestCell(x1,y1) of
           1..2 : Test[x1,y1] := false;
           5..10: Test[x1,y1] := false
         end
       else
         if TestCell(x1,y1) = 3 then Test[x1,y1] := true;
     end;
End;
{-----------------------------}
Procedure ShowCell(x0,y0:byte);
Begin
  SetFillStyle(solidfill,red);
  SetColor(black);
  HideMouse;
  FillEllipse(x0*round(640/xcell)-round(320/xcell),
              y0*round(480/ycell)-round(240/ycell),
              round(320/xcell)-1,round(240/ycell)-1);
  ShowMouse;
End;{ShowCell}
{-----------------------------}
Procedure HideCell(x0,y0:byte);
Begin
  SetFillStyle(solidfill,black);
  SetColor(black);
  HideMOuse;
  FillEllipse(x0*round(640/xcell)-round(320/xcell),
              y0*round(480/ycell)-round(240/ycell),
              round(320/xcell)-1,round(240/ycell)-1);
  ShowMouse;
End;{ShowCell}
{-----------------------------}
Procedure ShowAll;
Var
 x1,y1 :byte;
Begin
 for x1 := 1 to xcell do
  for y1 := 1 to ycell do
   begin
    if Test[x1,y1] <> Grid[x1,y1] then
     begin
      if Test[x1,y1] then ShowCell(x1,y1)
      else HideCell(x1,y1);
      Grid[x1,y1] := Test[x1,y1];
     end;
   end;
  Delay(Dl1);
End;{ShowAll}
{---------------------------}
Procedure Init;
Var
 j,i : byte;
Begin
 Repeat
   ClrScr;
   GotoXY(5,10);
   TextColor(Magenta);
   Write('‚¢¥¤¨â¥ ç¨á«® ª«¥â®ª ¯® X, Y, § ¤¥à¦ªã: ');
   ReadLn(Xcell,Ycell,Dl1);
 Until (Xcell in [1..160]) and (Ycell in [1..120]);
 InitVGA;
 SetColor(Blue);
 SetWriteMode(XORPut);
 Mouse;
 HideMouse;
 For j := 1 to ycell do Line(1,round(j*480/ycell),640,round(j*480/ycell));
 For j := 1 to xcell do Line(round(640/xcell)*j,1,round(640/xcell)*j,480);
End;{Init}
{-----------------------------}
Function LastTurn: boolean;
Var
  x,y : byte;
Begin
  LastTurn := true;
  for x := 1 to xcell do
   for y := 1 to ycell do if Test[x,y] <> Grid[x,y] then LastTurn := false;
End;{LastTurn}
{-------------------}
Procedure Game;
Var
 bool : boolean;
 c:char;
Begin
 Repeat
  Turn;
  bool := LastTurn;
  ShowAll;
  if keypressed then c := Readkey;
 Until bool or (c = #27) or (c=#13);
End;{Game}
{-----------------------------------------}
Procedure ReadPoints;
Var
  x0,y0 : integer;
  c:char;
Begin
  ShowMouse;
  repeat
    if keypressed then c := readkey;
    if mousepressed then
      begin
        MouseWhereXY(x0,y0);
        if Grid[x0 div round(640/xcell)+1,y0 div round(480/ycell)+1] then begin
          HideCell(x0 div round(640/xcell)+1,y0 div round(480/ycell)+1);
          Grid[x0 div round(640/xcell)+1,y0 div round(480/ycell)+1] := false;
         end
        else
         begin
          ShowCell(x0 div round(640/xcell)+1,y0 div round(480/ycell)+1);
          Grid[x0 div round(640/xcell)+1,y0 div round(480/ycell)+1] := true;
         end;
        Delay(3000);
      end;
  until (c = #27) or (c=#13);
End;
{-----------------------------------------}
Procedure ExitProgram;
Begin
  HideMouse;
  CloseGraph;
End;{ExitProgram}
{-----------------------------------------}
Function NotWant:boolean;
Var
  c : char;
  p : pointer;
  s : word;
  LastColor : integer;
Begin
  NotWant := false;
  LastColor := GetColor;
  HideMouse;
  s := ImageSize(160,160,480,320);
  GetMem(p,s);
  GetImage(160,160,480,320,p^);
  SetTextStyle(DefaultFont,HorizDir,3);
  SetTextJustify(CenterText,TopText);
  SetColor(Green);
  OutTextXY(320,180,'Life stopped');
  SetColor(Yellow);
  SetTextStyle(DefaultFont,HorizDir,1);
  OutTextXY(320,220,'Press Esc to Exit');
  OutTextXY(320,240,'Any other key to continue');
  c := readkey;
  if c = #27 then NotWant := true;
  PutImage(160,160,p^,NormalPut);
  FreeMem(p,s);
  Dispose(p);
  ShowMouse;
  SetColor(LastColor)
End;
{--------------------------------}
Begin
  Init;
  repeat
    ReadPoints;
    Game;
  until NotWant;
  ExitProgram;
End.