Programmer 7500/MAX_PROGRAMMERS.iso/INFO/FORTH/FIG_4TH.ZIP/LIFE.SCR

Text File | 1987-01-14 | 5.0 KB | 1 lines

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( THE GAME OF LIFE, ADAPTED FROM DAVE BOULTON )                 ( FORTH DIMENSIONS III/5 PAGE 24 )                              FORTH DEFINITIONS DECIMAL : TASK ;                              DECIMAL 39 CONSTANT XLEN 22 CONSTANT YLEN                       XLEN YLEN 2ARRAY UNIVERSE 0 VARIABLE #GENERATION                : J RP@ 6 + @ ;                                                 : CHECK DUP 3 = IF DROP 2+ ELSE 2 = 0=                            IF 4 + ENDIF ENDIF ;                                          : CLEAR  YLEN 0 DO XLEN 0 DO I J UNIVERSE                         0 SWAP C! LOOP LOOP ;                                         : DISPLAY PAGE ." Generation " #GENERATION @ .                    YLEN 0 DO XLEN 0 DO                                             I J UNIVERSE C@   IF I 2 * J GOTOXY 42 EMIT ENDIF               LOOP LOOP HOME ;                                              -->                                                                                                                             ( THE GAME OF LIFE, CONTINUED )                                 : X-      1 - DUP 0 < IF DROP XLEN 1 - ENDIF ;                  : X+      1 + DUP XLEN = IF DROP 0 ENDIF ;                      : Y-      1 - DUP 0 < IF DROP YLEN 1 - ENDIF ;                  : Y+      1 + DUP YLEN = IF DROP 0 ENDIF ;                      : CELL C@ 1 AND + ;                                             : GENERATE                                                        YLEN 0 DO XLEN 0 DO  0                                          I X- J UNIVERSE CELL I X+ J  UNIVERSE CELL                      I X- J Y+ UNIVERSE CELL I J Y+ UNIVERSE CELL                    I X+ J Y+ UNIVERSE CELL  I X- J Y- UNIVERSE CELL                I J Y- UNIVERSE CELL  I X+ J Y- UNIVERSE CELL                   I J UNIVERSE C@   1 AND SWAP CHECK   I J UNIVERSE C!            LOOP LOOP ;                                                   -->                                                                                                                             ( THE GAME OF LIFE, CONTINUED )                                 0 VARIABLE CUR 0 VARIABLE SETUPFLAG                             : .CUR CUR @ XLEN /MOD SWAP DUP + SWAP GOTOXY ;    : !CUR 0     MAX YLEN XLEN * 1 - MIN CUR ! ;   : +CUR CUR @ + !CUR ;         : +.CUR +CUR .CUR ; : +LIN CUR @ XLEN / + XLEN * !CUR ;         HEX 1B CONSTANT EXITFLAG 0A CONSTANT DOWNCURSOR                 0D CONSTANT NEWLINE 7F CONSTANT BACKCURSOR DECIMAL              : SETUPLIFE PAGE ." Enter starting pattern     "                ."            push <ESC> when finished " CR                     0 SETUPFLAG ! 0 CUR ! .CUR BEGIN KEY CASE EXITFLAG OF 1         SETUPFLAG ! ENDOF DOWNCURSOR OF XLEN +.CUR ENDOF                BACKCURSOR OF -1 +.CUR ENDOF NEWLINE OF 1 +LIN .CUR ENDOF       32 OF 32 EMIT 0 CUR @ XLEN /MOD UNIVERSE C! 1 +.CUR ENDOF       42 OF 42 EMIT 1 CUR @ XLEN /MOD UNIVERSE C! 1 +.CUR ENDOF       ENDCASE SETUPFLAG @ UNTIL ;                                     -->                                                             ( THE GAME OF LIFE, CONTINUED )                                 : NORMALIZE YLEN 0 DO XLEN 0 DO                                   I J UNIVERSE DUP C@ DUP                                         4 AND IF DROP 0 ELSE 3 AND IF 1 ELSE 0 ENDIF ENDIF              SWAP C!                                                         LOOP LOOP ;                                                                                                                   : GENERATIONS 1 #GENERATION ! CLEAR SETUPLIFE                     0 DO DISPLAY GENERATE                                           NORMALIZE 1 #GENERATION +! LOOP                                 DISPLAY XLEN YLEN GOTOXY ;                                                                                                    ." Type 'n GENERATIONS <CR>' to play  " ;S