Welcome to the CHICKEN Scheme pasting service
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))