Wireworld
Conway's Game of Life
It is capable of doing sophisticated computations with appropriate programs
(it is actually Turing complete),
and is much simpler to program for.

A Wireworld arena consists of a Cartesian grid of cells,
each of which can be in one of four states.
All cell transitions happen simultaneously.

The cell transition rules are this:



 Input State

 Output State

 Condition


 empty

 empty




 electron head 

 electron tail 




 electron tail 

 conductor




 conductor

 electron head 

 if 1 or 2 cells in the neighborhood of the cell are in the state “electron head”


 conductor

 conductor

 otherwise



Task

Create a program that reads a Wireworld program from a file and displays an animation of the processing. Here is a sample description file (using "H" for an electron head, "t" for a tail, "." for a conductor and a space for empty) you may wish to test with, which demonstrates two cycle-3 generators and an inhibit gate:

tH.........
.   .
   ...
.   .
Ht.. ......

While text-only implementations of this task are possible, mapping cells to pixels is advisable if you wish to be able to display large designs. The logic is not significantly more complex.




16 constant w
 8 constant h
 
: rows    w * 2* ;
1 rows constant row
h rows constant size
 
create world size allot
world   value old
old w + value new
 
: init   world size erase ;
: age    new old to new to old ;
 
: foreachrow ( xt -- )
  size 0 do  I over execute  row +loop drop ;
 
0 constant EMPTY
1 constant          HEAD
2 constant                    TAIL
3 constant                              WIRE
create cstate bl c, char H c, char t c, char . c,
 
: showrow ( i -- ) cr
  old + w over + swap do I c@ cstate + c@ emit loop ;
: show  ['] showrow foreachrow  ;
 
 
: line ( row addr len -- )
  bounds do
    i c@
    case
    bl of EMPTY over c! endof
    'H of HEAD  over c! endof
    't of TAIL  over c! endof
    '. of WIRE  over c! endof
    endcase
    1+
  loop drop ;
 
: load ( filename -- )
  r/o open-file throw
  init  old row + 1+  ( file row )
  begin  over pad 80 rot read-line throw
  while  over pad rot line
         row +
  repeat
  2drop close-file throw
  show cr ;
 
 
: +head ( sum i -- sum )
  old + c@ HEAD = if 1+ then ;
: conductor ( i WIRE -- i HEAD|WIRE )
  drop 0
  over 1- row - +head
  over    row - +head
  over 1+ row - +head
  over 1-       +head
  over 1+       +head
  over 1- row + +head
  over    row + +head
  over 1+ row + +head
  1 3 within if HEAD else WIRE then ;
 
\ before:          empty    head   tail   wire
 
create transition  ' noop , ' 1+ , ' 1+ , ' conductor ,
 
\ after:           empty    tail   wire   head|wire
 
: new-state ( i -- )
  dup  old + c@
  dup cells transition + @ execute
  swap new + c! ;
 
: newrow ( i -- )
  w over + swap do I new-state loop ;
: gen  ['] newrow foreachrow  age ;
 
: wireworld begin gen 0 0 at-xy show key? until ;