Life Game

Adapted by Joao Paulo Schwarz Schuler

uses dos,crt;

{ Life Game }
{ Turbo Pascal Source }
{ Constructed by John H. Conway }
{ Adapted by Joao Paulo Schwarz Schuler }

procedure DMG(b:BYTE);
VAR R:REGISTERS;
BEGIN
 R.AL:=B;
 R.AH:=0;
 INTR($10,R);
END;


type matr = array[0..199,0..319] of boolean ;
var cel ,cel2 :^matr;

function visit(x,y:integer):byte;
var co:byte;

begin
co:=0;
if cel2^[pred(Y),pred(X)]  then co:=co+1;
if cel2^[pred(Y),x      ]  then co:=co+1;
if cel2^[pred(Y),succ(X)]  then co:=co+1;

if cel2^[Y,      pred(X)] then co:=co+1;
if cel2^[Y,      succ(X)] then co:=co+1;

if cel2^[succ(Y),pred(X)] then co:=co+1;
if cel2^[succ(Y),X      ] then co:=co+1;
if cel2^[succ(Y),succ(X)] then co:=co+1;


visit:=co;
end;

var RVIDEO: array[0..199,0..319] of byte absolute $a000:0000;

procedure invis;
var i,i2:integer;
begin
for i:=0 to 319 do
    for i2:=0 to 199 do
        cel^[i2,i] := (RVIDEO[i2,i] <> 0);
end;


procedure invis2;
var i,i2:integer;
begin
cel2^:=cel^;
end;

var c:byte;
    xc,yc:integer;
    bo:boolean;
    CA:CHAR;

    TODOSMORTOS:boolean;
begin  (* begin of program *)
TODOSMORTOS:=true;
new(CEL);
new(CEL2);
randomize;
dmg($13);
invis;
repeat
   cel2^:=cel^;
   for yc:= 1 to 198 do
       for xc:=1 to 318 do
           begin            (* BEGIN of FOR *)
           c:=visit(xc,yc);
           if c=0 then
              begin
              if TODOSMORTOS and (yc>50) and (yc<66) and (xc>50) and (xc<250)
                 then cel^[yc,xc]:=(random(64)<1)
                 else cel^[yc,xc]:=false;
              end

            else cel^[yc,xc]:=( (c=2) and (cel2^[yc,xc])) or (c=3) {or (c=6)};
           end; (* END of FOR *)

   TODOSMORTOS:=true;

   for yc:= 1 to 199 do
       for xc:= 1 to 319 do
           begin
           if cel^[yc,xc] then
              begin
              {TODOSMORTOS:=false;}                     (* BEGIN of IF *)
              c:=RVIDEO[yc,xc];
              if c=0 then c:=24;
              if c=255 then   { testa longenvidade }
                 begin
                 cel^[yc,xc]:=false;
                 end
               else
                 begin
                 RVIDEO[yc,xc]:=c+1;
                 end;
              end                                                    (* END of IF *)
            else
              begin
              RVIDEO[yc,xc]:=0;
              end;
           end;
until keypressed;

dispose(CEL);
dispose(CEL2);
dmg(2);
clrscr;
highvideo;
textbackground(2);
writeln('                              Life Game',' ':38);
normvideo;
Writeln(' Turbo Pascal Source');
Writeln(' Constructed by John H. Conway ');
Writeln(' Adapted by Joao Paulo Schwarz Schuler ');
Writeln(' You can find the source! http://www.schulers.com/jpss/pascal/fontes.htm');

end.

Leia mais sobre o life.

Return to the Home Page

Return to the Fontes em Pascal Page