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.




 
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(require racket/fixnum)
 
; see the forest fire task, from which this is derived...
(define-struct wire-world (width height cells) #:prefab)
 
(define state:_ 0)
(define state:. 1)
(define state:H 2)
(define state:t 3)
 
(define (char->state c)
  (case c
    ((#\_ #\space) state:_)
    ((#\.) state:.)
    ((#\H) state:H)
    ((#\t) state:t)))
 
(define (initial-world l)
  (let ((h (length l))
        (w (string-length (first l))))
    (make-wire-world w h
                     (for*/fxvector
                      #:length (* h w)
                      ((row (in-list l))
                       (cell (in-string row)))
                      (char->state cell)))))
 
(define initial-list
  '("tH........."
    ".   .      "
    "   ...     "
    ".   .      "
    "Ht.. ......"))
 
(define-syntax-rule (count-neighbours-in-state ww wh wc r# c# state-to-match)
  (for/sum
      ((r (in-range (- r# 1) (+ r# 2)))
       #:when (< -1 r wh)
       (c (in-range (- c# 1) (+ c# 2)))
       #:when (< -1 c ww)
       ;; note, this will check cell at (r#, c#), too but it's not
       ;; worth checking that r=r# and c=c# each time in
       ;; this case, we know that (r#, c#) is a conductor:
       ; #:unless (and (= r# r) (= c# c))
       (i (in-value (+ (* r ww) c)))
       #:when (= state-to-match (fxvector-ref wc i)))
    1))
 
(define (cell-new-state ww wh wc row col)
  (let ((cell (fxvector-ref wc (+ col (* row ww)))))
    (cond
      ((= cell state:_) cell) ; empty -> empty
      ((= cell state:t) state:.) ; tail -> empty
      ((= cell state:H) state:t) ; head -> tail
      ((<= 1 (count-neighbours-in-state ww wh wc row col state:H) 2) state:H)
      (else cell))))
 
(define (wire-world-tick world)
  (define ww (wire-world-width world))
  (define wh (wire-world-height world))
  (define wc (wire-world-cells world))
 
  (define (/w x) (quotient x ww))
  (define (%w x) (remainder x ww))
 
  (make-wire-world
   ww wh
  (for/fxvector
   #:length (* ww wh)
   ((cell (in-fxvector wc))
    (r# (sequence-map /w (in-naturals)))
    (c# (sequence-map %w (in-naturals))))
   (cell-new-state ww wh wc r# c#))))
 
(define colour:_ (make-color   0   0   0))  ; black
(define colour:. (make-color  128 128 128)) ; grey
(define colour:H (make-color  128 255 255)) ; bright cyan
(define colour:t (make-color    0 128 128)) ; dark cyan
 
(define colour-vector (vector colour:_ colour:. colour:H colour:t))
(define (cell-state->colour state) (vector-ref colour-vector state))
 
(define render-scaling 20)
(define (render-world W)
  (define ww (wire-world-width W))
  (define wh (wire-world-height W))
  (define wc (wire-world-cells W))
   (let* ((flat-state
           (for/list ((cell (in-fxvector wc)))
             (cell-state->colour cell))))
     (place-image (scale render-scaling (color-list->bitmap flat-state ww wh))
                  (* ww (/ render-scaling 2))
                  (* wh (/ render-scaling 2))
                  (empty-scene (* render-scaling ww) (* render-scaling wh)))))
 
(define (run-wire-world #:initial-state W)
  (big-bang
   (initial-world W) ;; initial state
   [on-tick wire-world-tick
            1/8 ; tick time (seconds)
            ]
   [to-draw render-world]))
 
(run-wire-world #:initial-state initial-list)
 