Category : Files from Magazines
Archive   : DDJ8604.ZIP
Filename : PARKLST.APR

\ LIFE in Expert-2
\ by Jack Park

\ simple demo program - this version on MVP Forth
\ by Jack Park 1985

: WALL ; \ something to forget when done

NOSHOW \ a word added to EXPERT-2 to cause suppression of display
\ of any inferences. Sets a variable to 00. Variable is tested
\ by each printing word.

VARIABLE ARRAY1 510 ALLOT
VARIABLE ARRAY2 510 ALLOT
\ during a given pass through the cells, one array will be the
\ "old" array, the other the "new" array. On the next pass,
\ arrays reverse position.
: CLEAR1 ARRAY1 512 ERASE ;
: CLEAR2 ARRAY2 512 ERASE ;

VARIABLE ^OLD
VARIABLE ^NEW
VARIABLE ^CELL
VARIABLE ?CELL
VARIABLE CELLTOGGLE
VARIABLE II \ miscellaneous variable use in counting
VARIABLE JJ
VARIABLE KK

219 CONSTANT SYMBOL \ graphics symbol for IBM PC display
\ this symbol can be changed to virtually any ASCII symbol
\ e.g. ASCII * CONSTANT SYMBOL will print a "*" at each live cell

: IJ ( J I -- ) 32 * SWAP 2* + ^OLD @ + @ ( is alive? )
IF 1 ^CELL @ +! THEN ; \ printing symbol is truth value here
\ if a printing symbol is in a cell, it is alive.
\ if a cell is alive, increment count in center cell. Note, this
\ routine counts total of alive "nearest neighbors" to center
\ cell.

: FIX ( n -- n ) DUP -1 =
IF DROP 15
ELSE DUP 16 = IF DROP 0 THEN
THEN ; \ bounds checking for array edges
\ this form of bounds checking forces a square (flat) array to
\ behave like a torus - there will be end effects when a
\ life form grows beyond the visible edge of the array.

: SETCELL ( J I -- ) 32 * SWAP 2* + ^NEW @ + 0 OVER !

( clear cell ) ^CELL ! ( save cell address ) ;
\ support for numeric processing of cell counts

: DOCELLS 16 0 ( -- ) \ here is the main numeric loop
DO 16 0 ( note: 16 x 16 array of cells )
DO J I SETCELL
J 1- FIX I IJ
J 1+ FIX I IJ
J I 1- FIX IJ
J I 1+ FIX IJ
J 1- FIX I 1- FIX IJ
J 1- FIX I 1+ FIX IJ
J 1+ FIX I 1- FIX IJ

J 1+ FIX I 1+ FIX IJ
LOOP
LOOP ; \ count all alive cells around each cell

\ count is saved in "NEW" cell
\ this routine could be sped up, but it runs in about 2 seconds
\ as is.

: (INITCELL) ( y x -- ) 32 * SWAP 2 * + ARRAY1 + SYMBOL SWAP ! ;

: EATER ( a starting design ) CLEAR1
5 4 (INITCELL) 6 4 (INITCELL) 1 5 (INITCELL) 2 5 (INITCELL)
4 5 (INITCELL) 7 5 (INITCELL) 1 6 (INITCELL) 2 6 (INITCELL)
5 6 (INITCELL) 6 6 (INITCELL) ;

: PENTA ( a starting design ) CLEAR1
4 6 (INITCELL) 9 6 (INITCELL) 2 7 (INITCELL) 3 7 (INITCELL)
9 5 DO I 7 (INITCELL) LOOP 10 7 (INITCELL) 11 7 (INITCELL)
4 8 (INITCELL) 9 8 (INITCELL) ;
\ to run the system, one types PENTA RUN, or EATER RUN
\ consult BYTE Magazine, December 1978 for further details
\ cells will not necessarily behave as advertised because of
\ edge effects in a limited array

: SHOWCELLS HOME ( alias: PAGE, clearscreen) 16 0
DO 16 0
DO J 32 * I 2* + ^NEW @ + @ EMIT LOOP CR
LOOP CR KK @ . ; \ display the array


: RUN ( the main word ) CLEAR2 1 CELLTOGGLE !
\ be sure to call one of the starting patterns before RUN
ARRAY1 ^NEW ! 0 ?CELL ! 32 0 ( run up to 32 generations )
DO 16 0 I 1+ KK ! SHOWCELLS
DO I JJ ! 16 0
DO I II ! DIAGNOSE ( run the rules ) LOOP
LOOP 0 ?CELL ! ?TERMINAL IF LEAVE THEN ( tap any key to stop )
LOOP 1 KK +! SHOWCELLS ;
\ II, JJ, and KK carry loop counters outside the loops. It is
\ not possible to simply pass these values on the stack, because
\ they are used well into the DIAGNOSE - inference engine -
\ routine.

: RUNCELLS ( used by rules ) ?CELL @ NOT ( have we run yet? )
IF CELLTOGGLE @
IF ARRAY1 ^OLD ! ARRAY2 ^NEW ! 0
ELSE ARRAY2 ^OLD ! ARRAY1 ^NEW ! 1
THEN CELLTOGGLE ! DOCELLS ( get all the counts )
THEN 1 ?CELL ! ;

: (ADDR) JJ @ 32 * II @ 2* + ; \ numeric support

\ following are antecedent numeric tests used by the rules
: COUNT=0 (ADDR) ^NEW @ + @ 0= ; \ return truth to rules
: COUNT=1 (ADDR) ^NEW @ + @ 1 = ;
: COUNT=2 (ADDR) ^NEW @ + @ 2 = ;
: COUNT=3 (ADDR) ^NEW @ + @ 3 = ;
: COUNT>=4 (ADDR) ^NEW @ + @ 4 < NOT ;
: ?ALIVE ( -- tf ) RUNCELLS (ADDR) ^OLD @ + @ ;
\ note use of the print character as a truth flag in ?ALIVE.
\ each antecedent test returns a truth value based on a test:
\ e.g. COUNT=0 looks at the "current" new cell to see what the
\ count of its nearest neighbors has been found to be. Returns
\ TRUE if count = 0, otherwise returns FALSE. This value is
\ the truth value for the clause that called COUNT=0 in the
\ rules (ANDRUN COUNT=0, etc.)

\ following are consequent numeric procedures called by the
\ rules
: LIVE SYMBOL (ADDR) ^NEW @ + ! TRUE ( dummy truth value ) ;
: DIE 0 (ADDR) ^NEW @ + ! TRUE ;
\ note the use of SYMBOL as a truth value; SYMBOL must be > 0
: PROPAGATE (ADDR) ^OLD @ + @ (ADDR) ^NEW @ + ! TRUE ;
\ notice that all procedures must return a truth value to
\ the inference engine - even in the consequent fields.
\ e.g. LIVE stores the SYMBOL (which means the cell is now
\ alive) into the current cell, then returns a dummy TRUE.
\ following is the knowledge base
RULES \ beginning of rules, start the rule compiler
IFRUN ?ALIVE
ANDRUN COUNT=2
THEN cell lives
ANDTHENRUN LIVE
IFRUN ?ALIVE
ANDRUN COUNT=3
THEN cell lives
ANDTHENRUN LIVE
IFNOTRUN ?ALIVE
ANDRUN COUNT=3
THEN cell lives
ANDTHENRUN LIVE
IFRUN COUNT=0
THEN cell dies
ANDTHENRUN DIE
IFRUN COUNT>=4
THEN cell dies
ANDTHENRUN DIE
IFNOT cell lives
ANDNOT cell dies
THENHYP cell propagates
ANDTHENRUN PROPAGATE
DONE \ tidy up and stop the rule compiler.
\ note that EXPERT-2 inference engine must be modified with

\ addition of a variable to suppress printing out inferences.

\ EOF