;;; Fichier mapcellu.drs / 23 fevrier 1999
;;; DrScheme version 101
(require-library "graphics.ss" "graphics")


;;; Jeu de la vie simplifie:

(define (programme-cellule)
  (open-graphics)
  (let ((w (open-viewport "" (* nbcol coef) (* nbligne coef))))
    (cellule (automate-initial nbcol nbligne) w)))

(define (cellule aut fenetre)             ;...boucle infinie
  (affiche-matrice aut fenetre)
  (cellule (transforme-automate aut (car aut)) fenetre))

(define (transforme-automate aut bordure)
  (append (list bordure)
          (map-trois-bis (lambda (x y z)
                           (fabrique-ligne (cdr x) y (cddr y) (cdr z))) 
                         aut)
          (list bordure)))


;;; Calcul d'une ligne en fonction des 4 voisins Nord, Sud, Est, Ouest
;;; (le "jeu de la vie" utilise 8 voisins) 

;;; REGLE:
;;; ------
;;; 4 voisins egaux --> 0, sinon --> 1
;;; Bordure de 1 non modifiee. Matrice de 0 et 1 representee par liste de lignes.


(define (fabrique-ligne l1 l2 l3 l4)
  (append (list 1)
          (map-quatre (lambda (nord ouest est sud)
                        (if (and (= nord ouest) (= ouest est) (= est sud))
                            0 1))
                      l1 l2 l3 l4)
          (list 1)))

;;; Initialisation:
;;; creation de l'automate initial: 1 au bord, 0 a l'interieur

(define (automate-initial n p)
  (let ((l1 (repete 1 p))
        (l0 (append (list 1) (repete 0 (- p 2)) (list 1))))
    (append (list l1) (repete l0 (- n 2)) (list l1))))

;;; Iterateurs:

(define (map-quatre fonc l1 l2 l3 l4)
  (cond ((or (null? l1) (null? l2) (null? l3) (null? l4)) '())
        (else (cons (fonc (car l1) (car l2) (car l3) (car l4))
                    (map-quatre fonc (cdr l1) (cdr l2) (cdr l3) (cdr l4))))))

(define (map-trois-bis fonc l)
  (cond ((null? (cddr l)) '())
        (else (cons (fonc (car l) (cadr l) (caddr l))
                    (map-trois-bis fonc (cdr l))))))

(define (repete element k)
  (if (= k 0) '() (cons element (repete element (- k 1)))))


;;; Fonctions graphiques: ecran (largeur=1040, hauteur=740) 
;;;largeur=640, hauteur=480

(define coef 12)   ;;; 20 largeur des petits rectangles
(define nbcol 51)  
(define nbligne 36) 

(define (affiche-matrice aut w)
  (do ((mat aut (cdr mat))
       (x 0 (+ x coef)))     
    ((null? mat) 'fin)      
    (do ((l (car mat) (cdr l))
	 (y (* coef (- nbligne 1)) (- y coef)))	
      ((null? l) 'fin)	
      ((draw-solid-rectangle w)
       (make-posn x y) coef coef (if (= (car l) 0) "yellow" "black")))))