\ Free from Elliott Chapin (416) 921-9560.
\ L.O.V.E. Forth source code for LIFE.EXE.
\ Please distribute both files together only.
\ The program requires 80x25 colour text mode & an MS-compatible mouse.

: FOO ;

ASCII O CONSTANT BLOT  32 CONSTANT BLANK

72 CONSTANT UP  80 CONSTANT DOWN  77 CONSTANT RIGHT  75 CONSTANT LEFT

CREATE LIVES 2000 ALLOT  CREATE NEXTLIVES 2000 ALLOT

VARIABLE NEIGHBOURS

: AROUND ( a -- n )
 0 NEIGHBOURS !
 DUP 80 - DUP DUP 1- C@ 2*  NEIGHBOURS +!
                     C@ 3 * NEIGHBOURS +!
                  1+ C@ 2*  NEIGHBOURS +!
 DUP      DUP DUP 1- C@ 3 * NEIGHBOURS +!
                     C@     NEIGHBOURS +!
                  1+ C@ 3 * NEIGHBOURS +!
     80 + DUP DUP 1- C@ 2*  NEIGHBOURS +!
                     C@ 3 * NEIGHBOURS +!
                  1+ C@ 2*  NEIGHBOURS @ + ;

: NEWFIELD 2000 0 DO 0 LIVES I + C! LOOP
           LIVES NEXTLIVES 2000 CMOVE
           25 0 DO CR LOOP
           37 12 XYTAB
         BEGIN QTERM
          IF KEY
           CASE
            ASCII 1 OF XY@ 2DUP 80 * + LIVES + 1 SWAP C!
                       2DUP BLOT EMIT XYTAB ENDOF
            ASCII 0 OF XY@ 2DUP 80 * + LIVES + 0 SWAP C!
                       2DUP BLANK EMIT XYTAB ENDOF
            ASCII R OF EXIT ENDOF
            ASCII r OF EXIT ENDOF
            ASCII G OF BYE ENDOF
            ASCII g OF BYE ENDOF
            0 OF SCANCODE @
                  CASE
                   UP OF XY@ DUP IF 1- XYTAB THEN ENDOF
                   DOWN OF XY@ DUP 24 < IF 1+ XYTAB THEN ENDOF
                   RIGHT OF XY@ OVER 79 < IF SWAP 1+ SWAP XYTAB THEN ENDOF
                   LEFT OF XY@ OVER IF SWAP 1- SWAP XYTAB THEN ENDOF
                  ENDCASE  ENDOF
           ENDCASE
          THEN
         AGAIN ;

: NEXTGEN    24 1 DO  79 1 DO
   I J 80 * + LIVES + DUP C@
   IF DUP AROUND DUP 4 > SWAP 10 < AND
    IF LIVES - NEXTLIVES + 1 SWAP C!
    ELSE  LIVES - NEXTLIVES + 0 SWAP C! THEN
  ELSE DUP AROUND DUP 6 > SWAP 10 < AND
    IF LIVES - NEXTLIVES + 1 SWAP C!
    ELSE  LIVES - NEXTLIVES + 0 SWAP C! THEN
  THEN LOOP LOOP ;

: UPDATE
 NEXTLIVES LIVES 2000 CMOVE
 24 1 DO  79 1 DO
 I J 80 * + DUP NEXTLIVES + 0 SWAP C! LIVES + C@
  IF I J XYTAB BLOT EMIT
  ELSE I J XYTAB BLANK EMIT
  THEN LOOP LOOP ;

: RUN BEGIN NEXTGEN UPDATE ?TERMINAL UNTIL ;

: LIFE BEGIN NEWFIELD RUN AGAIN ;