home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / ddjmag / ddj8604.arc / PARKLST.APR < prev    next >
Text File  |  1986-04-30  |  6KB  |  172 lines
  1.  
  2. \ LIFE in Expert-2
  3. \ by Jack Park
  4.  
  5. \ simple demo program - this version on MVP Forth
  6. \ by Jack Park      1985
  7.  
  8. : WALL ; \ something to forget when done
  9.  
  10. NOSHOW \ a word added to EXPERT-2 to cause suppression of display
  11. \ of any inferences.  Sets a variable to 00.  Variable is tested
  12. \ by each printing word.
  13.  
  14. VARIABLE ARRAY1 510 ALLOT
  15. VARIABLE ARRAY2 510 ALLOT
  16. \ during a given pass through the cells, one array will be the
  17. \ "old" array, the other the "new" array.  On the next pass,
  18. \ arrays reverse position.
  19. : CLEAR1 ARRAY1 512 ERASE ;
  20. : CLEAR2 ARRAY2 512 ERASE ;
  21.  
  22. VARIABLE ^OLD
  23. VARIABLE ^NEW
  24. VARIABLE ^CELL
  25. VARIABLE ?CELL
  26. VARIABLE CELLTOGGLE
  27. VARIABLE II         \ miscellaneous variable use in counting
  28. VARIABLE JJ
  29. VARIABLE KK
  30.  
  31. 219 CONSTANT SYMBOL \ graphics symbol for IBM PC display
  32. \ this symbol can be changed to virtually any ASCII symbol
  33. \ e.g. ASCII * CONSTANT SYMBOL will print a "*" at each live cell
  34.  
  35. : IJ ( J I -- ) 32 * SWAP 2* + ^OLD @ + @ ( is alive? )
  36.   IF 1 ^CELL @ +! THEN ; \ printing symbol is truth value here
  37. \ if a printing symbol is in a cell, it is alive.
  38. \ if a cell is alive, increment count in center cell.  Note, this
  39. \  routine  counts total of alive "nearest neighbors"  to  center 
  40. \ cell.
  41.  
  42. : FIX ( n -- n ) DUP -1 =
  43.   IF DROP 15
  44.   ELSE DUP 16 = IF DROP 0 THEN
  45.   THEN ;  \ bounds checking for array edges
  46. \ this form of bounds  checking forces a square (flat) array to
  47. \ behave like a torus - there will be end effects when a
  48. \ life form grows beyond the visible edge of the array.
  49.  
  50. :  SETCELL  ( J I -- ) 32 * SWAP 2* + ^NEW @ + 0 OVER !  
  51.  
  52.   ( clear cell ) ^CELL ! ( save cell address ) ;
  53. \ support for numeric processing of cell counts
  54.  
  55. : DOCELLS 16 0  ( -- )  \ here is the main numeric loop
  56.   DO 16 0 ( note: 16 x 16 array of cells )
  57.     DO J I SETCELL
  58.           J 1- FIX I IJ
  59.           J 1+ FIX I IJ
  60.           J I 1- FIX IJ
  61.           J I 1+ FIX IJ
  62.           J 1- FIX I 1- FIX IJ
  63.           J 1- FIX I 1+ FIX IJ
  64.           J 1+ FIX I 1- FIX IJ
  65.           J 1+ FIX I 1+ FIX IJ
  66.     LOOP
  67.   LOOP ;  \ count all alive cells around each cell 
  68.  
  69. \ count is saved in "NEW" cell
  70. \ this routine could be sped up, but it runs in about 2 seconds
  71. \ as is.
  72.  
  73. : (INITCELL) ( y x -- ) 32 * SWAP 2 * + ARRAY1 + SYMBOL SWAP ! ;
  74.  
  75. : EATER ( a starting design ) CLEAR1
  76.   5 4 (INITCELL) 6 4 (INITCELL) 1 5 (INITCELL) 2 5 (INITCELL)
  77.   4 5 (INITCELL) 7 5 (INITCELL) 1 6 (INITCELL) 2 6 (INITCELL)
  78.   5 6 (INITCELL) 6 6 (INITCELL) ;
  79.  
  80. : PENTA ( a starting design ) CLEAR1
  81.   4 6 (INITCELL) 9 6 (INITCELL) 2 7 (INITCELL) 3 7 (INITCELL)
  82.   9 5 DO I 7 (INITCELL) LOOP 10 7 (INITCELL) 11 7 (INITCELL)
  83.   4 8 (INITCELL) 9 8 (INITCELL) ;
  84. \ to run the system, one types PENTA RUN, or EATER RUN
  85. \ consult BYTE Magazine, December 1978 for further details
  86. \ cells will not necessarily behave as advertised because of
  87. \ edge effects in a limited array
  88.  
  89. : SHOWCELLS HOME ( alias: PAGE, clearscreen) 16 0
  90.   DO 16 0
  91.     DO J 32 * I 2* + ^NEW @ + @ EMIT LOOP CR
  92.   LOOP CR KK @ . ;  \ display the array
  93.  
  94.  
  95. : RUN ( the main word ) CLEAR2 1 CELLTOGGLE ! 
  96. \ be sure to call one of the starting patterns before RUN
  97.   ARRAY1 ^NEW ! 0 ?CELL ! 32 0  ( run up to 32 generations )
  98.   DO 16 0 I 1+ KK ! SHOWCELLS
  99.     DO I JJ ! 16 0
  100.       DO I II ! DIAGNOSE ( run the rules ) LOOP
  101.     LOOP 0 ?CELL ! ?TERMINAL IF LEAVE THEN ( tap any key to stop )
  102.   LOOP 1 KK +! SHOWCELLS ;
  103. \ II,  JJ,  and KK carry loop counters outside the loops.   It is 
  104. \  not possible to simply pass these values on the  stack,  because
  105. \  they  are  used well into the DIAGNOSE  - inference  engine  - 
  106. \  routine.
  107.  
  108. : RUNCELLS ( used by rules ) ?CELL @ NOT ( have we run yet? )
  109.   IF CELLTOGGLE @
  110.     IF ARRAY1 ^OLD ! ARRAY2 ^NEW ! 0
  111.     ELSE ARRAY2 ^OLD ! ARRAY1 ^NEW ! 1
  112.     THEN CELLTOGGLE ! DOCELLS  ( get all the counts )
  113.   THEN 1 ?CELL ! ;
  114.  
  115. : (ADDR) JJ @ 32 * II @ 2* + ;  \ numeric support
  116.  
  117. \ following are antecedent numeric tests used by the rules
  118. : COUNT=0 (ADDR) ^NEW @ + @ 0= ; \ return truth to rules
  119. : COUNT=1 (ADDR) ^NEW @ + @ 1 = ;
  120. : COUNT=2 (ADDR) ^NEW @ + @ 2 = ;
  121. : COUNT=3 (ADDR) ^NEW @ + @ 3 = ;
  122. : COUNT>=4 (ADDR) ^NEW @ + @ 4 < NOT ;
  123. : ?ALIVE ( -- tf ) RUNCELLS (ADDR) ^OLD @ + @ ;
  124. \ note use of the print character as a truth flag in ?ALIVE.
  125. \ each antecedent test returns a truth value based on a test:
  126. \  e.g.  COUNT=0 looks at the "current" new cell to see what  the 
  127. \ count of its nearest neighbors has been found to be.  Returns
  128. \ TRUE if count = 0, otherwise returns FALSE.  This value is
  129. \ the truth value for the clause that called COUNT=0 in the
  130. \ rules (ANDRUN COUNT=0, etc.)
  131.  
  132. \ following are consequent numeric procedures called by the
  133. \ rules
  134. : LIVE SYMBOL (ADDR) ^NEW @ + ! TRUE ( dummy truth value ) ;
  135. : DIE 0 (ADDR) ^NEW @ + ! TRUE ;
  136. \ note the use of SYMBOL as a truth value; SYMBOL must be > 0
  137. : PROPAGATE (ADDR) ^OLD @ + @ (ADDR) ^NEW @ + ! TRUE ;
  138. \ notice that all procedures must return a truth value to
  139. \ the inference engine - even in the consequent fields.
  140. \ e.g. LIVE stores the SYMBOL (which means the cell is now 
  141. \ alive) into the current cell, then returns a dummy TRUE.
  142. \ following is the knowledge base
  143. RULES \ beginning of rules, start the rule compiler
  144.   IFRUN ?ALIVE
  145.   ANDRUN COUNT=2
  146.   THEN cell lives
  147.   ANDTHENRUN LIVE
  148. IFRUN ?ALIVE
  149. ANDRUN COUNT=3
  150. THEN cell lives
  151. ANDTHENRUN LIVE
  152.   IFNOTRUN ?ALIVE
  153.   ANDRUN COUNT=3
  154.   THEN cell lives
  155.   ANDTHENRUN LIVE
  156. IFRUN COUNT=0
  157. THEN cell dies
  158. ANDTHENRUN DIE
  159.   IFRUN COUNT>=4
  160.   THEN cell dies
  161.   ANDTHENRUN DIE
  162. IFNOT cell lives
  163. ANDNOT cell dies
  164. THENHYP cell propagates
  165. ANDTHENRUN PROPAGATE
  166. DONE  \ tidy up and stop the rule compiler.
  167. \  note  that  EXPERT-2 inference engine must  be  modified  with 
  168.  
  169. \  addition of a variable to suppress printing out inferences.
  170.  
  171.                   \ EOF
  172.