|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7616 (0x1dc0)
Notes: Mikados TextFile, Mikados_K
Names: »LIFE«
└─⟦ec8c1e0b0⟧ Bits:30007442 8" floppy ( MIKPROG vol. 1-3, MIKREL vol. 1-3, PCSE 4.7.80 vol 1-3, GL.SYS )
└─ ⟦this⟧ »LIFE«
PROGRAM LIFE;
(***************************************)
(* *)
(* G A M E O F L I F E *)
(* *)
(***************************************)
CONST
ON = 9; (* LIVING CELL SIGN *)
MAXROW = 22;
MAXROW1 = 23;
MAXCOL = 40;
MAXCOL1 = 41;
TYPE
STATE = (DEAD,STABLE,STABLE2,GROWING);
NEIGHBORS = 0 .. 17; (* 0 TO 8 = DEAD CELL *)
(* 9 = CELL ALIVE WITH NO NEIGBORS *)
(* 10 - 17 = CELL ALIVE WITH NEIGBORS *)
COLINDEX = 0 .. MAXCOL1;
ROWINDEX = 0 .. MAXROW1;
BOARD = PACKED ARRAY( ROWINDEX,COLINDEX ) OF NEIGHBORS;
VAR
BOARDSTATE : STATE;
ACTBOARD : BOARD;
SAVBOARD : BOARD;
SAV2BOARD : BOARD;
GENERATION : INTEGER;
ALIVECOUNT : INTEGER;
OUTCOUNT : INTEGER;
(* C L E A R B O A R D *)
PROCEDURE CLEARBOARD(VAR B: BOARD);
VAR ROW,COL: INTEGER;
BEGIN
FOR ROW := 0 TO MAXROW1 DO
FOR COL := 0 TO MAXCOL1 DO
B( ROW,COL ) := 0;
END (*CLEARBOARD*);
(* S E T C E L L *)
PROCEDURE SETCELL(VAR B: BOARD; ROW: ROWINDEX; COL: COLINDEX) ;
BEGIN
B( ROW-1,COL-1 ) := B( ROW-1,COL-1 ) + 1;
B( ROW-1,COL ) := B( ROW-1,COL ) + 1;
B( ROW-1,COL+1 ) := B( ROW-1,COL+1 ) + 1;
B( ROW ,COL-1 ) := B( ROW ,COL-1 ) + 1;
B( ROW ,COL ) := B( ROW ,COL ) + ON;
B( ROW ,COL+1 ) := B( ROW ,COL+1 ) + 1;
B( ROW+1,COL-1 ) := B( ROW+1,COL-1 ) + 1;
B( ROW+1,COL ) := B( ROW+1,COL ) + 1;
B( ROW+1,COL+1 ) := B( ROW+1,COL+1 ) + 1;
ALIVECOUNT := ALIVECOUNT+1;
END (* SETCELL *);
(* R E M O V E C E L L *)
PROCEDURE REMOVECELL(VAR B: BOARD; ROW: ROWINDEX; COL: COLINDEX);
BEGIN
B( ROW-1,COL-1 ) := B( ROW-1,COL-1 ) - 1;
B( ROW-1,COL ) := B( ROW-1,COL ) - 1;
B( ROW-1,COL+1 ) := B( ROW-1,COL+1 ) - 1;
B( ROW ,COL-1 ) := B( ROW ,COL-1 ) - 1;
B( ROW ,COL ) := B( ROW ,COL ) - ON;
B( ROW ,COL+1 ) := B( ROW ,COL+1 ) - 1;
B( ROW+1,COL-1 ) := B( ROW+1,COL-1 ) - 1;
B( ROW+1,COL ) := B( ROW+1,COL ) - 1;
B( ROW+1,COL+1 ) := B( ROW+1,COL+1 ) - 1;
ALIVECOUNT := ALIVECOUNT-1;
END (* REMOVECELL *);
(* R E A D G E N E R A T I O N *)
PROCEDURE READGENERATION;
VAR TEST : BOOLEAN;
CH : CHAR;
ROW,ROWMIN,ROWMAX,ROW0 : ROWINDEX;
COL,COLMIN,COLMAX,COL0 : COLINDEX;
BEGIN
GENERATION := 0;
ALIVECOUNT := 0;
CLEARBOARD(ACTBOARD);
SAVBOARD := ACTBOARD;
SAV2BOARD := ACTBOARD;
ROWMIN := MAXROW; ROWMAX := 0;
COLMIN := MAXCOL; COLMAX := 0;
ROW := 0;
TEST := FALSE;
WRITELN;
WRITELN('****** GAME OF LIFE ******');
WRITELN('PLEASE ENTER COLONY');
WRITELN('NONBLANK INDICATES LIVING CELL, BLANK IS DEAD CELL');
WRITELN('TERMINATE INPUT BY ENTERING BLANK LINE');
WRITELN('TERMINATE GAME OF LIFE BY ENTERING >.BR');
WHILE (ROW < MAXROW) AND NOT TEST DO
BEGIN
READLN;
TEST := EOLN;
ROW := ROW+1;
COL := 0;
WHILE (COL < MAXCOL) AND NOT EOLN DO
BEGIN
COL := COL+1;
READ(CH);
IF CH <> ' ' THEN
BEGIN
SETCELL(SAVBOARD,ROW,COL);
IF ROW < ROWMIN THEN ROWMIN := ROW;
IF COL < COLMIN THEN COLMIN := COL;
IF ROW > ROWMAX THEN ROWMAX := ROW;
IF COL > COLMAX THEN COLMAX := COL;
END;
END;
END;
(* PUT THE FIGURE IN THE MIDDLE *)
ROW0 := (MAXROW1-ROWMIN-ROWMAX) DIV 2;
COL0 := (MAXCOL1-COLMIN-COLMAX) DIV 2;
FOR ROW := ROWMIN-1 TO ROWMAX+1 DO
FOR COL := COLMIN-1 TO COLMAX+1 DO
ACTBOARD( ROW+ROW0,COL+COL0 ) := SAVBOARD( ROW,COL );
CLEARBOARD(SAVBOARD);
END (* READGENERATION *);
(* C E L L O N *)
PROCEDURE CELLON(Y,X: INTEGER);
BEGIN
GOTOXY( X+1, Y+3 );
WRITE('*')
END (* CELLON *);
(* C E L L O F F *)
PROCEDURE CELLOFF(Y,X: INTEGER);
BEGIN
GOTOXY( X+1,Y+3 );
WRITE(' ')
END (* CELLOFF *);
(* N E X T G E N E R A T I O N *)
PROCEDURE NEXTGENERATION;
VAR ROW: ROWINDEX;
COL: COLINDEX;
BEGIN
GENERATION := GENERATION+1;
SAV2BOARD := SAVBOARD;
SAVBOARD := ACTBOARD;
GOTOXY( 35, 1 );
WRITE(GENERATION:3);
OUTCOUNT := 0;
FOR ROW := 1 TO MAXROW DO
FOR COL := 1 TO MAXCOL DO
CASE SAVBOARD( ROW,COL ) OF
3 : BEGIN
(* A NEW CELL IS BORN! *)
SETCELL(ACTBOARD,ROW,COL);
CELLON(ROW-1,(COL-1)*2);
END;
9,10,13,14,15,16,17 :
BEGIN
(* A CELL DIES. IF 9 OR 10 FOR LONELINESS *)
(* IF 13 TO 17 BECAUSE TOO CROWDED *)
REMOVECELL(ACTBOARD,ROW,COL);
CELLOFF(ROW-1,(COL-1)*2);
END;
END (* CASE *);
END (* NEXTGENERATION *);
(* P R I N T G E N E R A T I O N *)
PROCEDURE PRINTGENERATION;
VAR ROW: ROWINDEX;
COL: COLINDEX;
BEGIN
OUTCOUNT := 0;
FOR ROW := 1 TO MAXROW DO
FOR COL := 1 TO MAXCOL DO
IF ACTBOARD( ROW,COL ) > 8 THEN
CELLON(ROW-1,(COL-1)*2);
END (* PRINTGENERATION *);
(* M A I N *)
BEGIN
READGENERATION;
CLEARSCREEN;
GOTOXY( 20, 1 );
WRITELN('GENERATION NO. 0 GROWING');
PRINTGENERATION;
REPEAT
NEXTGENERATION;
IF EOF(OUTPUT) THEN
BEGIN
GOTOXY( 1, MAXROW );
WRITELN('COLONY KILLED BY OPERATOR');
EXIT(LIFE)
END;
IF ALIVECOUNT = 0 THEN
BOARDSTATE := DEAD
ELSE
IF SAVBOARD = ACTBOARD THEN
BOARDSTATE := STABLE
ELSE
IF SAV2BOARD = ACTBOARD THEN
BOARDSTATE := STABLE2
ELSE
BOARDSTATE := GROWING;
UNTIL (BOARDSTATE <> GROWING);
IF BOARDSTATE = STABLE THEN
BEGIN
GOTOXY( 42, 1 );
WRITELN('STABLE ');
END
ELSE
IF BOARDSTATE = DEAD THEN
BEGIN
GOTOXY( 42, 1 );
WRITELN('DEAD ')
END
ELSE
IF BOARDSTATE = STABLE2 THEN
BEGIN
GOTOXY( 42, 1 );
WRITELN('STABLE OVER 2 GENERATIONS')
END;
GOTOXY( 1, MAXROW )
END (* MAIN *).