home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG150.ARC
/
LIFE2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
17KB
|
597 lines
Program Life;
Label 100;
Const
Height = 23;
Width = 60;
MinBound = - 1;
Lively = '+';
Deadly = ' ';
Type
State = (Alive, Dead);
Cell =
Record
LooksLikeItIs: State;
Nearby: Integer;
End;
Edges =
Record
Left, Right, Top, Bottom: Integer
End;
ScreenLine = String [80];
Var
Ch: Char;
yes_no: char;
Edge: Edges;
Births, Deaths, Generation, Pause, Population: Integer;
Board: Array [MinBound..Width, MinBound..Height] of Cell;
Function Yes(Line: ScreenLine): Boolean;
Var
Ch: Char;
Begin
Write(Line, '? ');
Repeat
Read(Kbd, Ch)
Until UpCase(Ch) in ['Y', 'N'];
Yes := UpCase(Ch) = 'Y'
End;
Function Min(a, b: Integer): Integer;
Begin
If a <= b then
Min := a
else
Min := b
End;
Function Max(a, b: Integer): Integer;
Begin
If a >= b then
Max := a
else
Max := b
End;
Procedure ResetEdges;
Begin
With Edge do
Begin
Top := Height - 1;
Right := MinBound + 1;
Left := Width - 1;
Bottom := MinBound + 1
End
End;
{$I Instrns.inc}
Procedure Initialize;
Var
Across, Down: Integer;
Begin
For Across := MinBound to Width do
For Down := MinBound to Height do
With Board[Across, Down] do
Begin
LooksLikeItIs := Dead;
Nearby := 0
End;
ResetEdges
End;
Procedure Limits(Across, Down: Integer);
Begin
With Edge do
Begin
Left := Min(Left, Across);
Right := Max(Right, Across);
Top := Min(Top, Down);
Bottom := Max(Bottom, Down)
End
End;
Procedure ClearNearby;
Var
Across, Down: Integer;
Begin
With Edge do
For Across := Left - 1 to Right + 1 do
For Down := Top - 1 to Bottom + 1 do
Board[Across, Down].Nearby := 0
End;
Procedure CountNeighbors;
Var
Across, DeltAcross, DeltaDown, Down: Integer;
Begin
ClearNearby;
With Edge do
For Across := Left - 1 to Right + 1 do
For Down := Top - 1 to Bottom + 1 do
If Board[Across, Down].LooksLikeItIs = Alive then
For DeltAcross := - 1 to 1 do
For DeltaDown := - 1 to 1 do
With Board[Across + DeltAcross, Down +
DeltaDown] do
Nearby := Succ(Nearby)
End;
Procedure UpDate;
Var
LocalEdge: Edges;
Across, Down: Integer;
Begin
Births := 0;
Deaths := 0;
LocalEdge := Edge;
ResetEdges;
For Across := Max(MinBound + 1, LocalEdge.Left - 1) to Min(Width - 1,
LocalEdge.Right + 1) do
For Down := Max(MinBound + 1,
LocalEdge.Top - 1) to Min(Height - 1, LocalEdge.Bottom + 1) do
With Board[Across, Down] do
Case LooksLikeItIs of
Dead:
If Nearby = 3 then
Begin
LooksLikeItIs := Alive;
GotoXY(Across + 1, Down + 1);
Write(Lively);
Limits(Across, Down);
Births := Births + 1
End;
Alive:
If (Nearby = 3) or (Nearby = 4) then
Limits(Across, Down)
else
Begin
LooksLikeItIs := Dead;
GotoXY(Across + 1, Down + 1);
Write(Deadly);
Deaths := Deaths + 1
End
End;
Generation := Generation + 1;
Population := Population + Births - Deaths;
GotoXY(Width + 15, 16);
Write(Generation: 5);
GotoXY(Width + 15, 17);
Write(Population: 5);
GotoXY(Width + 15, 18);
Write(Births: 5);
GotoXY(Width + 15, 19);
Write(Deaths: 5)
End;
Procedure DrawScreen;
Var
Index: Integer;
Begin
GotoXY(Width + 1, 1);
Write('+');
For Index := 2 to Height do
Begin
GotoXY(Width + 1, Index);
Write('|')
End;
GotoXY(1, Height + 1);
For Index := 1 to Width do
Write('-');
Write('+');
GotoXY(Width + 4, 1);
Write('The Game of Life.');
GotoXY(Width + 7, 2);
Write('Version 2.0');
GotoXY(Width + 11, 3);
Write('by');
GotoXY(Width + 7, 4);
Write('Cyrus Patel');
GotoXY(Width + 6, 6);
Write('^ ^ ^');
GotoXY(Width + 7, 7);
Write('\ | /');
GotoXY(Width + 8, 8);
Write('\ | /');
GotoXY(Width + 9, 9);
Write('7 8 9');
GotoXY(Width + 4, 10);
Write('<--- 4 * 6 --->');
GotoXY(Width + 9, 11);
Write('1 2 3');
GotoXY(Width + 8, 12);
Write('/ | \');
GotoXY(Width + 7, 13);
Write('/ | \');
GotoXY(Width + 6, 14);
Write('v v v');
GotoXY(Width + 4, 16);
Write('Generation:');
GotoXY(Width + 15, 16);
Write(0: 5);
GotoXY(Width + 4, 17);
Write('Population:');
GotoXY(Width + 15, 17);
Write(0: 5);
GotoXY(Width + 8, 18);
Write('Births:');
GotoXY(Width + 15, 18);
Write(0: 5);
GotoXY(Width + 8, 19);
Write('Deaths:');
GotoXY(Width + 15, 19);
Write(0: 5);
GotoXY(Width + 9, 20);
Write('Speed:');
GotoXY(Width + 15, 20);
Write(0: 5);
GotoXY(Width + 5, 23);
Write('ESC to t.')
End;
Procedure LoadScreen;
Var
InFile: Text;
Error: Boolean;
FileName: String [14];
Across, Down: Integer;
Begin
GotoXY(Width + 3, 21);
If Yes('Reset screen') then
Begin
For Across := MinBound to Width do
For Down := MinBound to Height do
With Board[Across, Down] do
If LooksLikeItIs = Alive then
Begin
GotoXY(Across + 1, Down + 1);
Write(' ');
LooksLikeItIs := Dead;
Nearby := 0
End;
ResetEdges;
Population := 0;
GotoXY(Width + 15, 17);
Write(Population: 5)
End;
GotoXY(Width + 3, 21);
Write('File name to load:');
GotoXY(Width + 5, 22);
BufLen := 14;
ReadLn(FileName);
GotoXY(Width + 3, 21);
ClrEol;
GotoXY(Width + 5, 22);
ClrEol;
If FileName <> '' then
Begin
GotoXY(Width + 6, 22);
Write('Loading...');
Assign(InFile, FileName);
Error := IOResult <> 0;
If Not Error then
begin
Reset(InFile);
Error := IOResult <> 0
End;
If Not Error then
Repeat
ReadLn(InFile, Across, Down);
If (Across >= MinBound) and (Down >= MinBound) and
(Down <= Height) and (Across <= Width) then
With Board[Across, Down] do
Begin
Limits(Across, Down);
If LooksLikeItIs = Dead then
Begin
GotoXY(Across + 1, Down + 1);
Write(Lively);
LooksLikeItIs := Alive;
Population := Population + 1;
GotoXY(Width + 15, 17);
Write(Population: 5)
End
End;
Error := IOResult <> 0
Until (Eof(InFile)) or (Error);
Close(InFile);
If Not Error then
Error := IOResult <> 0;
GotoXY(Width + 6, 22);
If Error then
Write('Loading Error!', Chr(7))
else
ClrEol
End
End;
Procedure SaveScreen;
Var
OutFile: Text;
Error: Boolean;
FileName: String [14];
Across, Down: Integer;
Begin
GotoXY(Width + 3, 21);
Write('File name to save:');
GotoXY(Width + 5, 22);
BufLen := 14;
ReadLn(FileName);
GotoXY(Width + 3, 21);
ClrEol;
GotoXY(Width + 5, 22);
ClrEol;
If FileName <> '' then
Begin
GotoXY(Width + 6, 22);
Write('Saving...');
Assign(OutFile, FileName);
Error := IOResult <> 0;
If Not Error then
Begin
ReWrite(OutFile);
Error := IOResult <> 0
End;
If Not Error then
For Across := MinBound to Width do
For Down := MinBound to Height do
With Board[Across, Down] do
If LooksLikeItIs = Alive then
If Not Error then
Begin
WriteLn(OutFile, Across: 1, ' ', Down: 1);
Error := IOResult <> 0
End;
Close(OutFile);
If Not Error then
Error := IOResult <> 0;
If Error then
Erase(OutFile);
GotoXY(Width + 6, 22);
ClrEol
End
End;
Procedure GetPositions;
Var
Ch: Char;
Across, Down, Index: Integer;
Begin
Down := 0;
Across := 0;
GotoXY(Width + 12, 23);
Write('star');
Repeat
GotoXY(Across + 1, Down + 1);
Index := - 15000;
If Not KeyPressed then
Repeat
If Index <= 32767 then
Index := Index + 1;
If Index = 0 then
Begin
GotoXY(Width + 6, 22);
ClrEol;
GotoXY(Across + 1, Down + 1)
End
else If Index = 32767 then
Begin
GotoXY(Width + 6, 22);
Write(Chr(7), 'Hurry up!!');
GotoXY(Across + 1, Down + 1);
Index := - 30000
End
Until KeyPressed;
Read(Kbd, Ch);
If (Ch = Chr(27)) and (KeyPressed) then
Begin
Read(Kbd, Ch);
Case Ord(Ch) of
71:
Ch := '7';
72:
Ch := '8';
73:
Ch := '9';
75:
Ch := '4';
77:
Ch := '6';
79:
Ch := '1';
80:
Ch := '2';
81:
Ch := '3'
end
End;
If Ch = ' ' then
Ch := '5';
If Index < 1 then
Begin
GotoXY(Width + 6, 22);
ClrEol;
GotoXY(Across + 1, Down + 1)
End;
Case Ch of
^L:
LoadScreen;
^S:
SaveScreen;
'1':
Begin
Across := Pred(Across);
Down := Succ(Down)
End;
'2':
Down := Succ(Down);
'3':
Begin
Across := Succ(Across);
Down := Succ(Down)
End;
'4':
Across := Pred(Across);
'5':
With Board[Across, Down] do
Begin
Limits(Across, Down);
If LooksLikeItIs = Alive then
Begin
Write(Deadly);
LooksLikeItIs := Dead;
Population := Population - 1
End
else
Begin
Write(Lively);
LooksLikeItIs := Alive;
Population := Population + 1
End;
GotoXY(Width + 15, 17);
Write(Population: 5)
End;
'6':
Across := Succ(Across);
'7':
Begin
Across := Pred(Across);
Down := Pred(Down)
End;
'8':
Down := Pred(Down);
'9':
Begin
Across := Succ(Across);
Down := Pred(Down)
End
End;
If Across > Width - 1 then
Begin
Across := 0;
Down := Succ(Down)
End
else If Across < 0 then
Begin
Across := Width - 1;
Down := Pred(Down)
End;
If Down > Height - 1 then
Down := 0
else If Down < 0 then
Down := Height - 1
Until Ch = Chr(27);
GotoXY(Width + 12, 23);
Write('abor')
End;
Begin
100:
Initialize;
Instructions;
DrawScreen;
Population := 0;
Generation := 0;
Pause := 32;
GetPositions;
GotoXY(Width + 15, 20);
Write(Pause Div 16: 5);
Repeat
CountNeighbors;
UpDate;
If Pause <> 0 then
For Ch := 'A' to 'Z' do
Delay(Pause);
If KeyPressed then
Begin
Read(Kbd, Ch);
Case Ch of
^M:
GetPositions;
^[:
If Not KeyPressed then
Population := 0;
'>', '.':
Pause := Min(Pause + 16, 255);
'<', ',':
Pause := Max(Pause - 16, 0)
End;
If Ch in ['>', '.', '<', ','] then
Begin
GotoXY(Width + 15, 20);
If Pause = 0 then
Write(Pause: 5)
else
Write(Pause Div 16: 5)
End
End
Until (Population = 0) or ((Births = 0) and (Deaths = 0));
GotoXY(Width + 5, 23);
ClrEol;
If Ch = Chr(27) then
Write(' Aborted!!')
else If Population = 0 then
Begin
GotoXY(Width + 3, 22);
Write('This colony has');
GotoXY(Width + 6, 23);
Write('died out.')
End;
GotoXY(1, 24);
clrscr;
writeln('ANOTHER RUN? Y/N');
readln(yes_no);
yes_no := upcase(yes_no);
if yes_no = 'Y'
then goto 100;
End.
