Category : Modula II Source Code
Archive   : MLIFE.ZIP
Filename : LIFE.MOD

 
Output of file : LIFE.MOD contained in archive : MLIFE.ZIP
MODULE Life;

(*
Title: Life.mod

Author: Randall A. Maddox
12209 M Peach Crest Drive
Germantown, MD 20874
(301) 428-9581

System: LOGITECH MODULA-2, MS/PCDOS, Version 3.03, December 1987

Description:

The game of LIFE as developed by John Horton Conway. For a complete
description see 'Wheels, Life and Other Mathematical Amusements' by
Martin Gardner, copyright 1983 by W.H. Freeman and Company.

NOTE: For purposes of this game, the opposite edges of the screen are
considered to be adjacent. That is, the game display will automatically
wrap around side to side and top to bottom, so that organisms that are on
opposite edges of the screen will be counted as neighbors when computing
the next generation, and any gliders or spaceships that fly off one edge
of the screen will fly back on from the opposite edge.

This version contains machine-specific code included from IMBSCR that makes
the program suitable only for IBM PC's or close clones running MSDOS 2.0
or better.

Update History:
Originally written: 12/20/85
Translated from TURBO-PASCAL to Logitech Modula-2: 11/21/88
Last update: 11/22/88

*)

(**************************************************************************)

IMPORT DebugPMD;

FROM CardinalIO IMPORT
WriteCardinal;

FROM Delay IMPORT
Delay;

FROM IBMSCR IMPORT
PosCur, ReadCh, ClrBox, ClrScr, PutScr, GetMode,
RdStr, WrtStr, WrtLst, Norm;

FROM LongIO IMPORT
WriteLongInt;

FROM NumberConversion IMPORT
StringToCard, StringToLongInt,
CardToString, LongIntToString;

FROM Random IMPORT
RandomCard;

FROM RTSMain IMPORT
Terminate, Status;

FROM SimpleTerm IMPORT
WriteLn;

FROM Strings IMPORT
Length, Delete, Concat;

FROM Utility IMPORT
KeyPressed;

(**************************************************************************)


CONST
RowMax = 23; (* One less than last screen line *)
ColMax = 79; (* Last screen column *)
MaxGen = MAX(LONGINT); (* Max long integer value allowed *)
Nul = 000C; (* ASCII null *)
LF = 012C; (* ASCII Line Feed *)
CR = 015C; (* ASCII carriage return *)
Esc = 033C; (* ASCII Escape key *)
Blank = 040C; (* ASCII space *)
Mature = 002C; (* Newborn and Mature may need to be *)
Newborn = 001C; (* redefined for your computer *)
Battr = 007C; (* Display attributes for Blank, Mature *)
Mattr = 017C; (* and Newborn may need to be redefined *)
Nattr = 007C; (* for your computer. *)
LArrow = 033C; (* LArrow, RArrow, UArrow and DArrow are *)
RArrow = 032C; (* nonstandard ASCII printable characters *)
UArrow = 030C; (* to print arrows on the screen. May need *)
DArrow = 031C; (* to be changed for your computer *)
Left = 113C; (* Left, Right, Up and Down should be *)
Right = 115C; (* set to the corresponding arrow *)
Up = 110C; (* key codes from your keyboard *)
Down = 120C;

TYPE
Org = RECORD
Kind : CHAR;
Attr : CHAR;
END;
CharSet = SET OF CHAR;

VAR
(* Organism matrices *)
Cell, Display : ARRAY [0..RowMax], [0..ColMax] OF Org;
Inp : ARRAY [0..9] OF CHAR; (* User input string *)
Inp1 : CHAR; (* Single character user input *)
Row, Col, TRow, TCol : CARDINAL;
Neighbors, Err, CurPage : CARDINAL;
Births, Deaths, Total : CARDINAL;
Max, I, J, K, PrevTotal : CARDINAL; (* Max := (RowMax+1)*(ColMax+1) *)
Generation, ACount : LONGINT;
Auto, Less, Hold : BOOLEAN; (* Flags *)
Stop, Done : BOOLEAN; (* Flags *)
Line : ARRAY [0..ColMax + 2] OF CHAR;
(* Used in printer output *)


(**************************************************************************)

PROCEDURE Initialize;

(* Called from MAIN program or StopGame *)

BEGIN (* Initialize variables and flags *)
GetMode(I,J,CurPage); (* get current video page *)
FOR Row := 0 TO RowMax DO (* Initialize Cell matrix *)
FOR Col := 0 TO ColMax DO
WITH Cell[Row,Col] DO
Kind := Blank;
Attr := Battr
END (* with *)
END (* for *)
END; (* for *)
Display := Cell; (* Initialize Display matrix *)
Max := (RowMax + 1) * (ColMax + 1); (* Maximum number of cells in play *)
Births := 0;
Deaths := 0;
Total := 0;
Generation := VAL(LONGINT,0);
ACount := VAL(LONGINT,0);
PrevTotal := 0;
Auto := FALSE;
Hold := FALSE;
Stop := FALSE
END Initialize;


(**************************************************************************)

PROCEDURE PlaceRandom;

(* Called from Menu *)

BEGIN (* Place organisms into grid at random *)
IF (Inp1 = '1') THEN
(* Computer picks random number to place *)
K := RandomCard(Max - Total - 1) + 1 (* 1 <= K < (Max - Total) *)
ELSE
(* User picks number to place at random *)
REPEAT
ClrScr;
PosCur(1,5,Err);
WrtStr('Enter number of organisms, 1 to ');
WriteCardinal((Max - Total - 1), 1);
WrtStr(': ');
RdStr(Inp);
StringToCard(Inp, K, Done)
UNTIL (Done) AND (K + Total < Max)
END;
ClrScr;
WrtStr('Placing ');
WriteCardinal(K, 1);
WrtStr(' organisms at random..........');
WriteLn;
J := K; (* save this to update counts later *)
Delay(750); (* give user chance to read message *)

(* The program first checks to see if the number of organisms to placed
at random, plus any organisms already present, is greater than 1/2 of
Max, the number of cells allowed. If it is, then the Cell matrix is
initialized to all newborn organisms and blank cells are placed at
random to bring their number down to the required amount. This is
done so that at most Max/2 cells need to be picked at random. *)

IF (((K + Total) * 2) <= Max) THEN
Less := TRUE
ELSE
(* Not Less *)
Less := FALSE; (* Flag to false *)
(* Cell to newborn *)
FOR Row := 0 TO RowMax DO
FOR Col := 0 TO ColMax DO
WITH Cell[Row,Col] DO
Kind := Newborn;
Attr := Nattr
END (* with *)
END (* for *)
END; (* for *)
(* and K to number of Blanks needed *)
K := Max - (K + Total)
END;
(* update counts *)
Births := Births + J;
Total := Total + J;
WHILE (K > 0) DO
Row := RandomCard(RowMax + 1); (* Pick Display coordinates at random *)
Col := RandomCard(ColMax + 1);
IF (Display[Row, Col].Kind = Blank) THEN
IF (Less) THEN
K := K - 1; (* Decrement counter *)
(* Make assignment *)
WITH Display[Row, Col] DO
Kind := Newborn;
Attr := Nattr
END (* with *)
ELSIF (Cell[Row, Col].Kind <> Blank) THEN
K := K - 1;
WITH Cell[Row, Col] DO
Kind := Blank;
Attr := Battr
END (* with *)
END (* if *)
END (* if *)
END; (* while *)
IF ( NOT Less) THEN
(* Transfer added Newborns to Display matrix *)
FOR Row := 0 TO RowMax DO
FOR Col := 0 TO ColMax DO
IF (Display[Row, Col].Kind = Blank) THEN
Display[Row, Col] := Cell[Row, Col]
END
END
END
END;
Cell := Display (* make sure Cell and Display in phase *)
END PlaceRandom;


(**************************************************************************)

PROCEDURE UserPlace;

(* Called from Menu *)

BEGIN (* User places organisms as desired *)
ClrScr;
WrtStr('You may use the following commands to manipulate the cursor and position');
WriteLn;
WrtStr('your starting population of organisms. If you go off the edge of the screen');
WriteLn;
WrtStr('in any direction, the cursor will wrap around to come back onto the screen');
WriteLn;
WrtStr('from the opposite edge.');
WriteLn;
WriteLn;
WrtStr(' ');
WrtStr(LArrow);
WrtStr(' = move cursor one cell left');
WriteLn;
WrtStr(' ');
WrtStr(RArrow);
WrtStr(' = move cursor one cell right');
WriteLn;
WrtStr(' ');
WrtStr(UArrow);
WrtStr(' = move cursor one cell up');
WriteLn;
WrtStr(' ');
WrtStr(DArrow);
WrtStr(' = move cursor one cell down');
WriteLn;
WrtStr(' O = place organism in current cell');
WriteLn;
WrtStr(' E = erase organism in current cell');
WriteLn;
WrtStr(' Q = quit, exit to start of game.');
WriteLn;
WriteLn;
WriteLn;
WriteLn;
WrtStr('Press any key to continue: ');
ReadCh(Inp1,Done);
ClrScr;
PosCur(1,RowMax+1,Err);
WrtStr(LArrow);
WrtStr(', ');
WrtStr(RArrow);
WrtStr(', ');
WrtStr(UArrow);
WrtStr(', ');
WrtStr(DArrow);
WrtStr(', (O)rganism, (E)rase, (Q)uit');
(* show current display *)
PutScr(0,ColMax,0,RowMax,Display,CurPage,Err);
Col := 0;
Row := 0;
Inp1 := Blank;
LOOP
(* Loop forever, or until user quits *)
PosCur(Col,Row,Err);
WrtStr(Display[Row, Col].Kind);
PosCur(Col,Row,Err);
ReadCh(Inp1,Done);
Inp1 := CAP(Inp1);
IF (Inp1 = Left) THEN
IF (Col = 0) THEN
Col := ColMax
ELSE
Col := Col - 1
END
ELSIF (Inp1 = Right) THEN
IF (Col = ColMax) THEN
Col := 0
ELSE
Col := Col + 1
END
ELSIF (Inp1 = Up) THEN
IF (Row = 0) THEN
Row := RowMax
ELSE
Row := Row - 1
END
ELSIF (Inp1 = Down) THEN
IF (Row = RowMax) THEN
Row := 0
ELSE
Row := Row + 1
END
ELSIF (Inp1 = 'O') THEN
WITH Display[Row, Col] DO
Kind := Newborn;
Attr := Nattr
END; (* with *)
(* update counts *)
Births := Births + 1;
Total := Total + 1
ELSIF (Inp1 = 'E') THEN
WITH Display[Row, Col] DO
(* update counts as needed *)
IF (Kind = Newborn) THEN
Births := Births - 1;
Total := Total - 1
ELSIF (Kind = Mature) THEN
Total := Total - 1
END; (* if *)
Kind := Blank;
Attr := Battr
END (* with *)
ELSIF (Inp1 = 'Q') THEN (* User wants to quit *)
Cell := Display; (* make sure Cell and Display in phase *)
EXIT (* exit from this procedure *)
END (* if *)
END (* loop *)
END UserPlace;


(**************************************************************************)

PROCEDURE StopGame;

(* Called from Menu or MAIN *)

BEGIN (* See if user wants to play again or quit *)
REPEAT
ClrScr;
PosCur(1, 5,Err);
WrtStr('Play again? (Y/N): ');
ReadCh(Inp1,Done);
Inp1 := CAP(Inp1);
UNTIL (Inp1 IN CharSet{'Y','N'});
IF (Inp1 = 'N') THEN
(* Exit program *)
ClrScr;
Terminate(Normal)
END
END StopGame;


(**************************************************************************)

PROCEDURE Menu;

(* Called from Instruct, Start or ChangeDisplay *)

BEGIN (* Display Main Menu (Changes Menu), get user input *)
ClrScr;
PosCur(32, 5,Err);
IF (Generation = VAL(LONGINT,0)) THEN
WrtStr('Program Main Menu')
ELSE
WrtStr('Make Changes Menu')
END;
WriteLn;WriteLn;WriteLn;
IF (Generation = VAL(LONGINT,0)) THEN
WrtStr('You may start this program in one of three ways:');
WriteLn
ELSE
WrtStr('You may change the current display in one of three ways:');
WriteLn
END;
WriteLn;WriteLn;
WrtStr(' 1) The computer generates a random number of organisms and places');
WriteLn;
WrtStr(' them into the grid at random.');
WriteLn;WriteLn;
WrtStr(' 2) You pick a number from 1 to ');
WriteCardinal((Max - Total -1), 1);
WrtStr(' and the computer randomly');
WriteLn;
WrtStr(' places that many organisms into the grid.');
WriteLn;WriteLn;
WrtStr(' 3) You place from 1 to ');
WriteCardinal((Max - Total - 1), 1);
WrtStr(' organisms into the grid in any');
WriteLn;
WrtStr(' configuration you may desire.');
WriteLn;WriteLn;WriteLn;WriteLn;
REPEAT
ClrBox(0,ColMax,22,RowMax+1,Norm,Err);
PosCur(0, 22, Err);
WrtStr('Enter number of your choice, or Q to quit: ');
ReadCh(Inp1,Done);
Inp1 := CAP(Inp1)
UNTIL (Inp1 IN CharSet{'1', '2', '3', 'Q'});
IF (Inp1 = '1') OR (Inp1 = '2') THEN
PlaceRandom
ELSIF (Inp1 = '3') THEN
UserPlace
ELSE (* Inp1='Q' *)
Stop := TRUE
END
END Menu;


(**************************************************************************)

PROCEDURE Instruct;

(* Called from Start *)

BEGIN (* Display instructions for game *)
ClrScr;
WrtStr('This game is played on a ');
WriteCardinal(RowMax+1, 1);
WrtStr(' by ');
WriteCardinal(ColMax+1, 1);
WrtStr(' grid. This gives a');
WriteLn;
WrtStr('total of ');
WriteCardinal(Max, 1);
WrtStr(' cells to be displayed on the screen. The basic idea is');
WriteLn;
WrtStr('to start with a simple configuration of cells occupied by organisms, then');
WriteLn;
WrtStr("to observe how this configuration changes as Conway's genetic laws are");
WriteLn;
WrtStr('applied. The genetic laws are simple:');
WriteLn;WriteLn;
WrtStr(' SURVIVALS: Every organism with either two or three neighbors survives');
WriteLn;
WrtStr(' to become a mature organism in the succeeding generation.');
WriteLn;WriteLn;
WrtStr(' DEATHS: Every organism with less than two or more than three neighbors');
WriteLn;
WrtStr(' dies.');
WriteLn;WriteLn;
WrtStr(' BIRTHS: Each empty cell with exactly three neighbors becomes occupied');
WriteLn;
WrtStr(' by a newborn organism in the succeeding generation.');
WriteLn;WriteLn;
WrtStr('The first ');
WriteCardinal(RowMax+1, 1);
WrtStr(' lines of the screen will display the current organism');
WriteLn;
WrtStr('configuration while the last line is used for status messages. The');
WriteLn;
WrtStr('display is as follows:');
WriteLn;
WriteLn;
WrtStr(' Blank for unoccupied cells');
WriteLn;
WrtStr(' ');
WrtStr(Newborn);
WrtStr(' for newborn organisms');
WriteLn;
WrtStr(' ');
WrtStr(Mature);
WrtStr(' for mature organisms.');
WriteLn;WriteLn;WriteLn;
WrtStr('Press any key to continue: ');
ReadCh(Inp1,Done);
Menu
END Instruct;


(**************************************************************************)

PROCEDURE Draw;

(* Called from MAIN Program or GetInput*)

BEGIN (* Draw current Display on screen *)
IF (Generation = VAL(LONGINT,0)) AND (NOT Hold) THEN
(* Print instructions only on initial pass *)
ClrScr;
WrtStr('NOTE: As each generation of organisms is displayed, the last line');
WriteLn;
WrtStr('on the screen will be updated to show current generation number, how');
WriteLn;
WrtStr('many births and deaths occurred since the last generation, and the total');
WriteLn;
WrtStr('number of organisms currently alive.');
WriteLn;WriteLn;
WrtStr('The last item on this line is a prompt that says: Q to quit:');
WriteLn;
WrtStr('At this prompt you have 5 options:');
WriteLn;
WriteLn;
WrtStr(' 1) Enter a Q to stop the current game. You may then start a new');
WriteLn;
WrtStr(' game or quit the program entirely.');
WriteLn;WriteLn;
WrtStr(' 2) Press Return to display the next generation of organisms.');
WriteLn;WriteLn;
WrtStr(' 3) Enter a valid integer less than 2,147,483,648 and the program will');
WriteLn;
WrtStr(' automatically display that many generations, pausing at each');
WriteLn;
WrtStr(' display briefly before proceeding to the next generation.');
WriteLn;
WrtStr(' This process may be aborted by pressing any key. The Q');
WriteLn;
WrtStr(' prompt will then reappear after the display');
WriteLn;WriteLn;
WrtStr(' 4) Enter a C to make changes to the current display.');
WriteLn;WriteLn;
WrtStr(' 5) Enter a P to print out a copy of the current display.');
WriteLn;WriteLn;WriteLn;
WrtStr('Press any key to continue: ');
ReadCh(Inp1,Done);
ClrScr
END; (* of first pass instructions *)
PutScr(0,ColMax,0,RowMax,Display,CurPage,Err) (* actual draw *)
END Draw;


(**************************************************************************)

PROCEDURE Start;

(* Called from MAIN Program *)

BEGIN (* Display program name, see if user needs instructions *)
ClrScr;
PosCur(32, 10,Err);
WrtStr('The Game of LIFE');
PosCur(22, 12,Err);
WrtStr('Game developed by John Horton Conway');
PosCur(18, 13,Err);
WrtStr('This program written by Randall Allan Maddox');
WriteLn;WriteLn;WriteLn;
REPEAT
ClrBox(0,ColMax,16,RowMax+1,Norm,Err);
PosCur(0,16,Err);
WrtStr(' Do you need instructions? (Y/N): ');
ReadCh(Inp1,Done);
Inp1 := CAP(Inp1)
UNTIL (Inp1 IN CharSet{'Y', 'N'});
IF (Inp1 = 'N') THEN
Menu
ELSE
Instruct
END
END Start;


(**************************************************************************)

PROCEDURE PrintDisplay;

(* Called from GetInput *)

BEGIN (* Output current display to printer, no advance to next generation *)
Hold := TRUE;
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,Err);
PosCur(0,RowMax+1,Err);
WrtStr('Printer on and Selected? (Y/N): ');
REPEAT
ReadCh(Inp1,Done);
Inp1 := CAP(Inp1)
UNTIL (Inp1 IN CharSet{'Y','N'});
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,Err);
PosCur(0,RowMax+1,Err);
IF (Inp1 = 'Y') THEN
WrtStr('Append CR/LF to each line? (Y/N): ');
REPEAT
ReadCh(Inp1,Done);
Inp1 := CAP(Inp1)
UNTIL (Inp1 IN CharSet{'Y','N'});
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,Err);
PosCur(0,RowMax+1,Err);
WrtStr('Printing copy of current generation.......... ');
Row := 0;
LOOP
Delete(Line, 0, ColMax + 2); (* Clear contents of Line *)
FOR Col := 0 TO ColMax DO (* Put one row of Display into Line *)
Line[Col] := Display[Row, Col].Kind
END; (* For *)
IF (Inp1 = 'Y') THEN (* append CR/LF *)
Line[ColMax+1] := CR;
Line[ColMax+2] := LF
ELSE (* append 2 nulls *)
Line[ColMax+1] := Nul;
Line[ColMax+2] := Nul
END; (* if *)
WrtLst(Line,Err); (* and write Line to printer *)
IF (Err = 0) THEN (* write went OK *)
IF (Row < RowMax) THEN (* increment Row *)
Row := Row + 1
ELSE (* all done OK *)
EXIT
END
ELSE (* write failed *)
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,I);
PosCur(0,RowMax+1,I);
WrtStr('Printing error: ');
WriteCardinal(Err,1);
WrtStr('Press any key to continue: ');
ReadCh(Inp1,Done);
EXIT
END (* if *)
END; (* loop *)
IF (Err = 0) THEN (* print status line too *)
Delete(Line, 0, ColMax + 2); (* Clear contents of Line *)
Line := 'Generation: ';
LongIntToString(Generation, Inp, 1);
Concat(Line,Inp,Line);
Concat(Line,' Births: ',Line);
CardToString(Births,Inp,1);
Concat(Line,Inp,Line);
Concat(Line,' Deaths: ',Line);
CardToString(Deaths,Inp,1);
Concat(Line,Inp,Line);
Concat(Line,' Total: ',Line);
CardToString(Total,Inp,1);
Concat(Line,Inp,Line);
IF (Inp1 = 'Y') THEN (* append CR/LF *)
Line[ColMax+1] := CR;
Line[ColMax+2] := LF
ELSE (* append 2 nulls *)
Line[ColMax+1] := Nul;
Line[ColMax+2] := Nul
END; (* if *)
WrtLst(Line,Err)
END (* if *)
END; (* if *)
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,I);
PosCur(0,RowMax+1,I)
END PrintDisplay;


(**************************************************************************)

PROCEDURE ChangeDisplay;

(* Called from GetInput *)

BEGIN (* Change current Display, no advance to next generation *)
Hold := TRUE; (* Flag to hold current generation *)
Menu
END ChangeDisplay;


(**************************************************************************)

PROCEDURE SetAuto;

(* Called from GetInput *)

BEGIN (* If valid integer input, set counter and Auto flag *)
StringToLongInt(Inp, ACount, Done);
IF (Done) AND (ACount >= VAL(LONGINT,2)) THEN
Auto := TRUE;
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,Err);
PosCur(0,RowMax+1,Err);
WrtStr('Computing next generation.......... ')
ELSE
Auto := FALSE
END
END SetAuto;


(**************************************************************************)

PROCEDURE GetInput;

(* Called from BottomLine *)


BEGIN (* Get user input at Q prompt *)
REPEAT
Done := TRUE;
WrtStr(' Q to quit (or ?): ');
RdStr(Inp);
Inp[0] := CAP(Inp[0]);
IF (Inp[0] = 'Q') THEN
Stop := TRUE
ELSIF (Inp[0] = 'P') THEN
PrintDisplay
ELSIF (Inp[0] = 'C') THEN
ChangeDisplay
ELSIF (Inp[0] = '?') THEN
ACount := Generation + VAL(LONGINT,1);
Generation := VAL(LONGINT,0);
Draw; (* gives instructions on Generation = 0 *)
Generation := ACount - VAL(LONGINT,1);
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,Err);
PosCur(0,RowMax+1,Err);
WrtStr('Generation: ');
WriteLongInt(Generation, 1);
WrtStr(' Births: ');
WriteCardinal(Births, 1);
WrtStr(' Deaths: ');
WriteCardinal(Deaths, 1);
WrtStr(' Total: ');
WriteCardinal(Total, 1);
Done := FALSE
ELSIF (Length(Inp) > 0) THEN
SetAuto
ELSE
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,Err);
PosCur(0,RowMax+1,Err);
WrtStr('Computing next generation.......... ')
END
UNTIL Done
END GetInput;


(**************************************************************************)

PROCEDURE BottomLine;

(* Called from MAIN Program *)

BEGIN (* Update status line, call GetInput if necessary *)
Hold := FALSE;
IF (Generation > VAL(LONGINT,0)) THEN
Deaths := PrevTotal + Births - Total
END; (* if *)
(* Make sure status line clear *)
ClrBox(0,ColMax,RowMax+1,RowMax+1,Norm,Err);
PosCur(0,RowMax+1,Err);
IF (Auto) THEN
ACount := ACount - VAL(LONGINT,1); (* Decrement counter *)
IF (ACount > VAL(LONGINT,0)) THEN
Auto := NOT(KeyPressed()) (* check for interrupt of auto *)
ELSE (* all done *)
Auto := FALSE
END (* if *)
END;
IF (Births = 0) AND (Deaths = 0) AND
(Generation > VAL(LONGINT,0)) AND (Total <> 0) THEN
WrtStr('Generation: ');
WriteLongInt(Generation, 1);
WrtStr(' Total: ');
WriteCardinal(Total, 1);
WrtStr(' ** STABLE ** ');
Auto := FALSE;
GetInput
ELSIF (Total = 0) THEN
WrtStr('All organisms dead at generation: ');
WriteLongInt(Generation, 1);
WrtStr(' ');
Auto := FALSE;
GetInput
ELSE
(* Not stable or all dead *)
WrtStr('Generation: ');
WriteLongInt(Generation, 1);
WrtStr(' Births: ');
WriteCardinal(Births, 1);
WrtStr(' Deaths: ');
WriteCardinal(Deaths, 1);
WrtStr(' Total: ');
WriteCardinal(Total, 1);
IF (NOT Auto) THEN
GetInput
END
END
END BottomLine;


(**************************************************************************)

PROCEDURE NextGeneration;

(* Called from MAIN Program *)

BEGIN
(* Following Conway's genetic rules and using the Display matrix as the
basis, the Cell matrix is updated to the next generation *)
PrevTotal := Total; (* save old Total *)
Births := 0; (* Zero out old numbers *)
Deaths := 0;
Total := 0;
FOR Row := 0 TO RowMax DO
FOR Col := 0 TO ColMax DO
IF (Display[Row,Col].Kind = Blank) THEN
(* Possible birth cell *)
Neighbors := 0;
IF (Col > 0) THEN
TCol := Col - 1
ELSE
TCol := ColMax
END;
IF (Display[Row, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row > 0) THEN
TRow := Row - 1
ELSE
TRow := RowMax
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row < RowMax) THEN
TRow := Row + 1
ELSE
TRow := 0
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Display[TRow, Col].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row > 0) THEN
TRow := Row - 1
ELSE
TRow := RowMax
END;
IF (Display[TRow, Col].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Col < ColMax) THEN
TCol := Col + 1
ELSE
TCol := 0
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Display[Row, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row < RowMax) THEN
TRow := Row + 1
ELSE
TRow := 0
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Neighbors = 3) THEN
Total := Total + 1;
Births := Births + 1;
WITH Cell[Row,Col] DO
Kind := Newborn;
Attr := Nattr
END (* with *)
END (* if *)
ELSE (* Possible death cell *)
Neighbors := 0;
IF (Col > 0) THEN
TCol := Col - 1
ELSE
TCol := ColMax
END;
IF (Display[Row, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row > 0) THEN
TRow := Row - 1
ELSE
TRow := RowMax
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row < RowMax) THEN
TRow := Row + 1
ELSE
TRow := 0
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Display[TRow, Col].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row > 0) THEN
TRow := Row - 1
ELSE
TRow := RowMax
END;
IF (Display[TRow, Col].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Col < ColMax) THEN
TCol := Col + 1
ELSE
TCol := 0
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Display[Row, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
IF (Row < RowMax) THEN
TRow := Row + 1
ELSE
TRow := 0
END;
IF (Display[TRow, TCol].Kind <> Blank) THEN
Neighbors := Neighbors + 1
END;
WITH Cell[Row,Col] DO
IF (Neighbors = 2) OR (Neighbors = 3) THEN
Total := Total + 1;
Kind := Mature;
Attr := Mattr
ELSE
Kind := Blank;
Attr := Battr
END
END (* with *)
END (* if *)
END (* for *)
END; (* for *)
Display := Cell; (* Put updated Cell matrix into Display matrix *)
IF (Generation = MaxGen) THEN (* Check for Generation overflow *)
ClrScr;
(* Reset counter, display message *)
Generation := VAL(LONGINT,1);
WrtStr('Generation equal to ');
WriteLongInt(MaxGen,1);
WriteLn;
WrtStr('Generation counter being automatically reset to 1.');
WriteLn;WriteLn;
WrtStr('Program will continue after 5 second delay.');
Delay(5000);
ClrScr
ELSE
Generation := Generation + VAL(LONGINT,1)
END (* if *)
END NextGeneration;



(**************************************************************************)

BEGIN (* MAIN Program *)
LOOP (* Loop forever, or until user quits *)
Initialize;
Start;
IF (NOT Stop) THEN
Draw;
WHILE (NOT Stop) DO
BottomLine;
IF (NOT (Hold OR Stop)) THEN
NextGeneration;
Draw
END (* if *)
END (* while *)
END; (* if *)
StopGame (* give user chance to quit *)
END (* loop *)
END Life. (* of MAIN Program *)

(* end of this file *)


  3 Responses to “Category : Modula II Source Code
Archive   : MLIFE.ZIP
Filename : LIFE.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/