modified wolf.csi added by anonymous on Sat Jan 14 15:48:51 2012

#!/usr/local/chicken/bin/csi -s

;(use srfi-1 srfi-27 ezxdisp)
(use srfi-1 ezxdisp)

(define (list->boxes! window list line size)
  (let ((x 0)
        (y (* line size)))
  (for-each (lambda (c)
                (begin
                  (when (> c 0) (ezx-fillrect-2d window x y (+ x size) (+ y size) (make-ezx-color 0 0 0)))
                  (set! x (+ x size))))
              list)))


(define (colored-cell? cells rule)
  (let* ((pos (length cells))
         (code (fold + 0 (map (lambda (n)
                                (set! pos (- pos 1))
                                (* (expt 2 pos) n))
                     cells))))
        (> (bitwise-and (arithmetic-shift 1 code) rule) 0)))

(define (get-neighbours l left)
  (cond ((null? l) '())
        ((< (length l) 2) (cons (flatten left (car l)) (get-neighbours (cdr l) (car l))))
        (else (cons (flatten left (car l) (cadr l)) (get-neighbours (cdr l) (car l))))))

(define (automata-output list rule)
  (map (lambda (n) (if (colored-cell? n rule) 1 0))
       (get-neighbours list '())))

(define (random-start size)
  (map (lambda (n) (random 2)) (iota size)))

(define (one-cell size)
  (let ((cells (make-list (inexact->exact (floor (/ size 2 ))) 0)))
    (append cells '(1) cells)))


(define (wolfram window size rule rounds start box-size #!optional (line 0))
  (if (= 0 rounds) '()
      (let ((next (automata-output start rule)))
        (begin
          (list->boxes! window start line box-size)
          (cons start (wolfram window size rule (- rounds 1) next box-size (add1 line)))))))

(define (draw-automata height width rule box-size #!optional (start #f))
  (let ((w (ezx-init width height (sprintf "Wolfram's automata rule #~a" rule))))
    (wolfram w
             (inexact->exact (floor (/ width box-size)))
             rule
             (inexact->exact (floor (/ height box-size)))
             (if (not start) (one-cell (inexact->exact (floor (/ width box-size)))))
             box-size)
    (ezx-redraw w)
    w))

(when ( < (length (argv)) 4)
      (printf #<<END
~a - draws simple wolfram cellular automata~%
~a width height rule~%

Opens a window with the given height and width and
draws the CA with the given rule.

See A new Kind of Science by Stephen Wolfram for
an explanation of the rules.~%
END
(car (argv)) (car (argv)))
(exit 0))


(let* ((args (map string->number (drop (argv) 1)))
       (w (first args))
       (h (second args))
       (r (third args))
       (b 2)
       (w (time (draw-automata h w r b))))
  (printf "Press RETURN to close window~%")
  (read-line)
  (ezx-quit w))