{ Life Game }
{ Virtual Pascal Source for OS/2 }
{ Constructed by John H. Conway }
{ Adapted by Joao Paulo Schwarz Schuler }
uses Os2Base,Use32;
const
VioMode: VioModeInfo =
( cb: SizeOf(VioModeInfo);
fbType: vgmt_Other + vgmt_Graphics;
Color: colors_256;
Col: 40;
Row: 25;
HRes: 320;
VRes: 200
);
VioBuf: VioPhysBuf =
( pBuf: Ptr($a0000);
cb: 64*1024
);
type
Ptr16Rec = record
Ofs,Sel: SmallWord;
end;
function KeyPressed: Boolean;
var
Key: KbdKeyInfo;
begin
KbdCharIn(Key, io_NoWait, 0);
KeyPressed := (Key.fbStatus and kbdtrf_Final_Char_In) <> 0;
end;
type matr = array[1..320,1..200] of boolean ;
var cel ,cel2 :^matr;
function visit(x,y:integer):byte;
var co:byte;
begin
co:=0;
if cel2^[x-1,y-1] then co:=co+1;
if cel2^[x ,y-1] then co:=co+1;
if cel2^[x+1,y-1] then co:=co+1;
if cel2^[x-1,y] then co:=co+1;
if cel2^[x+1,y] then co:=co+1;
if cel2^[x-1,y+1] then co:=co+1;
if cel2^[x ,y+1] then co:=co+1;
if cel2^[x+1,y+1] then co:=co+1;
visit:=co;
end;
var OrgMode: VioModeInfo;
procedure HaltError(const ErrMsg: String);
begin
VioSetMode(OrgMode, 0);
WriteLn('**Error** ', ErrMsg);
Halt(1);
end;
var VioBufOfs: Longint;
c:byte;
xc,yc:integer;
bo:boolean;
CA:CHAR;
procedure invis;
var i,i2:integer;
begin
for i:=1 to 320 do
for i2:=1 to 200 do
cel^[i,i2] := (mem[VioBufOfs+i*320+i2] <> 0);
end;
begin (* begin of program *)
OrgMode.cb := SizeOf(VioModeInfo);
VioGetMode(OrgMode, 0);
if VioSetMode(VioMode, 0) <> 0 then
HaltError('VGA display required.');
if VioGetPhysBuf(VioBuf, 0) <> 0 then
HaltError('Cannot access video screen selector.');
Ptr16Rec(VioBufOfs).Ofs := 0;
Ptr16Rec(VioBufOfs).Sel := VioBuf.Sel;
SelToFlat(Pointer(VioBufOfs));
FillChar(Pointer(VioBufOfs)^,64*1024,0);
new(CEL);
new(CEL2);
randomize;
for xc:=1 to 9000 do
mem[VioBufOfs+((round(random(318))+1)*320+round(random(198))+1)]:=25;
invis;
repeat
cel2^:=cel^;
for yc:= 1 to 199 do
for xc:=1 to 319 do
begin
c:=visit(xc,yc);
if c=0 then cel^[xc,yc]:=false
else cel^[xc,yc]:=((c=2) and (cel2^[xc,yc])) or (c=3);
end;
for yc:= 1 to 199 do
for xc:= 1 to 319 do
begin
if cel^[xc,yc] then
begin
c:=mem[VioBufOfs+yc*320+xc];
if c=0 then
c:=24;
mem[VioBufOfs+yc*320+xc]:=c+1;
end
else
mem[VioBufOfs+yc*320+xc]:=0;
end; { for }
until keypressed;
VioSetMode(OrgMode, 0);
dispose(CEL);
dispose(CEL2);
end.
Return to the Home Page
I want to read your E-Mail