LIFE.ATR Disk Image
LIFE.P is from the Apple Pascal Games by Douglas Hergert and Joseph T. Kalash published by Sybex. It is a Pascal implementation of John Conway's Game of Life of cellular automaton. I modify it slightly to get it working with in Kyan Pascal 2.x on the Atari 8-bit.
When entering the starting configuration, enter data as "Y[space]X". Don't use commas between the numbers as you will get a runtime error. To stop entering cells, enter something outside the range such as "-9[space]-9".
Not sure why the program was designed to enter data as Y,X instead of X,Y.
The program could be updated to change the Y,X format to X,Y. It could also be updated to give an option of generating a random or manual entry starting configuration.
It could also be updated to use one of the bit-mapped graphics modes, such as Graphics Mode 3. Note that increasing the data structure from anything more than the current 24 x 40 will likely significantly slow down the program's execution.
Press (or tap) any key to exit.
Source Code
(* LIFE.P *)
(* From the book 'Apple Pascal Games' *)
(* Modified for Kyan Pascal 2.x on the Atari 8-bit *)
program LIFE(input,output);
const
height = 24; (* Number of lines on screen *)
width = 40; (* Number of columns on screen *)
minbound = -1; (*Minimum dimension of screen bounds *)
clearscreen = 125; (* ATASCII Clear Screen Character *)
type
state = (Alive, Dead);
cell = record (* Each position has a state *)
LooksLikeItIs : state;
nearby : integer; (* and a count of the number *)
end; (* of adjacent living cells *)
edges = record (* The edges of a colony are the *)
left, (* coordinates of a square that *)
right, (* would contain the pattern *)
top,
bottom : integer;
end;
var
board : array [minbound..height] of array [minbound..width] of cell;
population, births, deaths : integer;
ch : char; (* Buffer for character that user may *)
edge : edges; (* type to 'interrupt' the cycle *)
#i peekpoke.i
#i cursor.i
#i position.i
function keypress : boolean;
var
k : integer;
begin
keypress := false;
k := peek(764);
if k <> 255 then
begin
poke(764,255);
keypress := true;
end;
end;
(*
* Initializes the edges of the pattern. This starts representing
* a pattern which has no insides; the top is lower than the bottom,
* the left side is to the right of the right side. This ensures
* that the coordinates of the corner of the pattern after it
* is entered will be correct without needing to scan the entire
* array after the pattern is entered (a time-consuming process).
*)
procedure ResetEdges;
begin
edge.top := height-1;
edge.right := minbound+1;
edge.left := width-1;
edge.bottom := minbound+1;
end;
procedure instructions;
var
answer : char;
begin
write(chr(clearscreen));
write('Would you like instructions for Life? ');
readln(answer);
while not (answer in ['Y', 'N']) do
begin
writeln('Please answer Yes or No.');
write('? ');
readln(answer);
end;
if answer = 'Y' then
begin
writeln('Life simulates the growth of a colony');
writeln('of animals on a 0..',height-1:1,' by 0..',width-1:1,' ''world''.');
writeln('Whether a cell is born, lives, or');
writeln('dies depends on the number of living');
writeln('animals immediately adjacent to it.');
writeln('If a cell is empty and has exactly 3');
writeln('neighbors it will be born in the');
writeln('next generation. If it is alive and');
writeln('has either two or three neighbors it');
writeln('will continue to live. Otherwise it');
writeln('dies of loneliness or overcrowding.');
writeln(' The initial pattern is entered by');
writeln('typing the row and then the column of');
writeln('the desired position. A cell is removed');
writeln('by entering its position again. To');
writeln('finish entering give a position ');
writeln('outside of the dimensions of the screen.');
writeln('To stop a pattern just hit any key.');
writeln('Type <RETURN> to start: ');
readln;
end;
write(chr(clearscreen));
end;
(*
* Initialize : Resets the board to empty ( all dead and
* with no neighbors.)
*)
procedure initialize;
var
down, across : integer;
begin
instructions;
for down := minbound to height do
for across := minbound to width do
begin
board[down,across].LooksLikeItIs := Dead;
board[down,across].nearby := 0;
end;
ResetEdges;
end; (* initialize *)
(*
* Max (& Min) : Returns the larger (smaller) of the two
* integer arguments
*)
function max(a,b:integer):integer;
begin
if a >= b then
max := a
else
max := b
end;
function min(a,b:integer):integer;
begin
if a <= b then
min := a
else
min := b
end;
(* Determine if a n how the co-ordinates passed as argument
* change the bounds of the pattern ( the position of a box that
* could contain the living cells), checking that it does not
* go off one of the sides of the board.
*)
procedure limits(x,y:integer);
begin
with edge do
begin
left := min(left,x);
right := max(right, x);
top := min(top,y);
bottom := max(bottom,y);
end;
end;
(*
* This erases the record of the neighbors
* of all the cells, in preparation for the
* new calculation of the nearby field
*)
procedure clearnearby;
var
down, across : integer;
begin
for down := edge.top-1 to edge.bottom+1 do
for across := edge.left-1 to edge.right+1 do
board[down][across].nearby := 0;
end; (* clearnearby *)
(*
* Computes the number of adjacent cells, and thus
* which cells will survive through the next generation.
* To speed this up, the middle cell of the 3 by 3 matrix
* which is being examined is included in the count, event though
* it is not really a neighbor of itself. This off-by-one
* discrepancy is taken into account in the board update.
*)
procedure countneighbors;
var
down, across : integer;
deltadown, deltaacross : integer;
begin
clearnearby;
for down := edge.top-1 to edge.bottom+1 do
for across := edge.left-1 to edge.right+1 do
if board[down][across].LooksLikeItIs = Alive then
for deltadown := -1 to 1 do
for deltaacross := -1 to 1 do
board[down+deltadown][across+deltaacross].nearby :=
board[down+deltadown][across+deltaacross].nearby + 1;
end; (* CountNeighbors *)
(*
* Update
* If a birth or death occurs the screen is updated.
*)
procedure update;
var
down, across : integer;
localedge : edges;
begin
births := 0;
deaths := 0;
localedge := edge;
resetedges;
for down := max(minbound + 1, localedge.top -1) to
min(height -1, localedge.bottom + 1) do
for across := max(minbound+1,localedge.left-1) to
min(width-1,localedge.right+1) do
with board[down][across] do
case LooksLikeItIs of
dead:
if nearby = 3 then
begin
LooksLikeItIs := Alive;
Position(Across,Down);
write('*');
Limits(Across,Down);
Births := Births + 1;
end;
Alive:
if (nearby=3) or (nearby=4) then
Limits(Across,Down)
else
begin
LooksLikeItIs := Dead;
Position(Across,Down);
Write(' ');
Deaths := Deaths + 1;
end;
end; (* Case *)
Population := Population + Births - Deaths;
end; (* Update *)
(*
* Get the starting positions of the cells
*)
procedure GetPositions;
var
down, across : integer;
finished : boolean;
(*
* This is needed to reprint the top line of the pattern, which
* is destroyed by the prompt line which asks for the cell positions
*)
procedure ReprintTopLine;
var
across : integer;
begin
Position(0,0);
For across := minbound +1 to width -1 do
if board[minbound + 1][across].LooksLikeItIs = Dead then
write(' ')
else
write('*');
end; (* ReprintTopLine *)
begin
finished := false;
Population := 0;
Position(0,0);
write('Position of cell #',Population+1:1, ' is :');
while not Finished do
begin
readln(Down, Across);
if (Down <= MinBound) or (* Finish entering the pattern by *)
(Down >= Height) or (* specifying a number which is *)
(Across <= MinBound) or (* not in the pattern *)
(Across >= Width) then
Finished := True
Else With Board[Down][Across] do
begin
Limits(Across,Down);
Position(Across,Down);
if LooksLikeItIs = Alive then (* Already something there *)
begin (* so remove it *)
write(' ');
LooksLikeItIs := Dead;
Population := Population - 1;
end
else (* Add a new cell *)
begin
write('*');
LooksLikeItIs := Alive;
Population := Population+1;
end;
Position(0,0);
write('Position of Cell #', Population +1:1, ' is :');
end;
end; (* While Continuing To Read Positions *)
ReprintTopLine;
end; (* GetPositions *)
(* Main Program *)
begin
disable_cursor;
initialize;
GetPositions;
Repeat
CountNeighbors;
Update;
Until (Population = 0) or
((Births = 0) and (Deaths = 0)) or
keypress = TRUE;
Position(0,0);
if Population = 0 then
Writeln('This colony has died.')
else
Write('The Pattern is stable');
enable_cursor;
end. (* Life *)
No comments:
Post a Comment