C
C		LIFE
C
C	CELLULAR AUTOMATON GAME
C
C	CODED TO USE DIRECT CURSOR ADDRESSING FEATURE OF
C	VT52 TERMINAL.  WRITTEN IN VAX FORTRAN IV-PLUS
C	NOVEMBER 3, 1977 BY KEVIN W. HARRIS
C
	PROGRAM LIFE

C	SET UP THE DATA AND THE SCREEN
C
	CALL INIT
	CALL DISPLAY


C	REPEATEDLY GENERATE A NEW DISPLAY
C
C	NOTE: UPDATE WILL STOP THE PROGRAM WHEN IT SEES A STABLE
C	      PATTERN.  OTHERWISE IT MUST BE STOPPED WITH A CTRL/C.
C
1	CALL NEWGEN
	CALL UPDATE

	GO TO 1
	END


C	INIT
C
C	SETS UP THE DATA ARRAY 'OLD'
C
	SUBROUTINE INIT
	INCLUDE 'LIFDCL.FOR'
	CHARACTER*40 FILENAME


C	INITIALLY BLANK ALL CELLS
C
	DO 5 I=1,1920
5	EOLD(I) = .FALSE.


C	OPEN THE FILE WITH THE STARTING PATTERN
C
	TYPE 100
100	FORMAT(' ENTER FILENAME OF STARTING PATTERN: ',$)
	ACCEPT 101,N,(FILENAME(I:I),I=1,N)
101	FORMAT(Q,<N>A1)
	OPEN(UNIT=4,TYPE='OLD',NAME=FILENAME(:N),READONLY)

C	READ, VALIDATE, AND APPLY EACH SPECIFIED COORDINATE PAIR
C
1	READ(4,*,END=25) ROW, COL

	IF(ROW.LT.1 .OR. ROW.GT.24)GO TO 1
	IF(COL.LT.1 .OR. COL.GT.80)GO TO 1

	OLD(ROW,COL) = .TRUE.
	GO TO 1

C	CLOSE INPUT FILE IN CASE OF ABORTED EXECUTION
C
25	CLOSE(UNIT=4)
	RETURN
	END


C	NEWGEN
C
C	COMPUTES NEW GENERATION AND RECORDS CHANGES
C
	SUBROUTINE NEWGEN
	INCLUDE 'LIFDCL.FOR'

C	ZERO THE COUNT ARRAY
C
	DO 10 I=1,2106
10	ZC(I) = 0

C	APPLY THE COUNTING ALGORITHM
C
	DO 80 I=1,1920

	    IF(EOLD(I))THEN

		COL = (I-1)/24 + 1
		ROW = MOD(I,24)
		IF (ROW.EQ.0) ROW = 24

		COUNTS(ROW-1,COL-1) = COUNTS(ROW-1,COL-1) + 1
		COUNTS(ROW-1,COL) = COUNTS(ROW-1,COL) + 1
		COUNTS(ROW-1,COL+1) = COUNTS(ROW-1,COL+1) + 1

		COUNTS(ROW,COL-1) = COUNTS(ROW,COL-1) + 1
		COUNTS(ROW,COL+1) = COUNTS(ROW,COL+1) + 1

		COUNTS(ROW+1,COL-1) = COUNTS(ROW+1,COL-1) + 1
		COUNTS(ROW+1,COL) = COUNTS(ROW+1,COL) + 1
		COUNTS(ROW+1,COL+1) = COUNTS(ROW+1,COL+1) + 1

	    ENDIF

80	CONTINUE

C	COMPUTE THE NEW PATTERN AND RECORD CHANGES
C
	IND = 0

	DO 280 ROW=1,24
	    DO 270 COL=1,80

		GO TO (1,1,2,3,1,1,1,1,1), COUNTS(ROW,COL)+1

C		CASE 1  TOO MANY OR TOO FEW NEIGHBORS
C
1		NEW(ROW,COL) = .FALSE.
		IF(OLD(ROW,COL))THEN
		    IND = IND + 1
		    ROWS(IND) = ROW
		    COLS(IND) = COL
		    CHARS(IND) = ' '
		ENDIF
		GO TO 270

C		CASE 2  TWO NEIGHBORS, STATE UNCHANGED
C
2		NEW(ROW,COL) = OLD(ROW,COL)
		GO TO 270

C		CASE 3  ALWAYS ALIVE
C
3		NEW(ROW,COL) = .TRUE.
		IF(.NOT.OLD(ROW,COL))THEN
		    IND = IND + 1
		    ROWS(IND) = ROW
		    COLS(IND) = COL
		    CHARS(IND) = '*'
		ENDIF

270	    CONTINUE
280	CONTINUE

C	TRANSFER NEW INFO
C
C	NOTE: THIS COULD BE ELIMINATED BY PING-PONGING THE ARRAYS
C
	DO 290 I=1,1920
290	EOLD(I) = ENEW(I)

	RETURN
	END

C	DISPLAY
C
C	DISPLAYS THE INITIAL PATTERN
C
	SUBROUTINE DISPLAY
	INCLUDE 'LIFDCL.FOR'
	BYTE ERASE(4),POS(4),CR
	DATA ERASE/27,72,27,74/,POS/27,89,0,0/,CR/13/

C	OPEN THE TERMINAL FOR NCC OUTPUT
C
	OPEN(UNIT=1,NAME='SYS$OUTPUT',CARRIAGECONTROL='NONE')
	WRITE(1,100)ERASE
100	FORMAT(4A1)

	COUNT = 0

C	FOR SET POINTS, SEND A CHARACTER
C
	DO 10 ROW=1,24
	    DO 9 COL=1,80

		IF(OLD(ROW,COL))THEN

		    POS(3) = ROW + 31
		    POS(4) = COL + 31
		    WRITE(1,101)POS,'*'
101		    FORMAT(4A1,A1)

C		    PUT OUT A <CR> ONCE IN A WHILE TO KEEP THE
C		    TERMINAL DRIVER HAPPY
C
		    COUNT = COUNT + 1
		    IF(COUNT.GE.10)THEN
			WRITE(1,102)CR
102			FORMAT(A1)
			COUNT = 0
		    ENDIF
		ENDIF
9	    CONTINUE
10	CONTINUE

	RETURN
	END

C	UPDATE
C
C	PROCESS THE LIST COMMON TO UPDATE THE SCREEN
C
	SUBROUTINE UPDATE
	INCLUDE 'LIFDCL.FOR'
	BYTE POS(4),START(3),CR
	DATA POS/27,89,0,0/,START/27,72,13/,CR/13/

C	INITIALIZE THE TERMINAL DRIVER'S COUNT
C
	WRITE(1,100)START
100	FORMAT(3A1)

C	IF NO CHANGES, WE HAVE A STABLE PATTERN, SO STOP
C
	IF(IND.EQ.0)STOP

C	PUT OUT EACH CHANGE
C
	DO 10 I=1,IND

	    POS(3) = ROWS(I) + 31
	    POS(4) = COLS(I) + 31
	    WRITE(1,101)POS,CHARS(I)
101	    FORMAT(4A1,A1)

C	    <CR> OUTPUT FOR TERMINAL DRIVER
C
	    IF (MOD(I,10) .EQ. 0) THEN
		WRITE(1,102)CR
102		FORMAT(A1)
	    ENDIF

10	CONTINUE

	RETURN
	END